mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
4847 lines
145 KiB
ObjectPascal
4847 lines
145 KiB
ObjectPascal
// *************************************************************************** }
|
|
//
|
|
// Delphi MVC Framework
|
|
//
|
|
// Copyright (c) 2010-2024 Daniele Teti and the DMVCFramework Team
|
|
//
|
|
// https://github.com/danieleteti/delphimvcframework
|
|
//
|
|
// ***************************************************************************
|
|
//
|
|
// Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0
|
|
//
|
|
// Unless required by applicable law or agreed to in writing, software
|
|
// distributed under the License is distributed on an "AS IS" BASIS,
|
|
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
// See the License for the specific language governing permissions and
|
|
// limitations under the License.
|
|
//
|
|
// ***************************************************************************
|
|
|
|
unit MVCFramework.ActiveRecord;
|
|
|
|
{$I dmvcframework.inc}
|
|
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Generics.Defaults,
|
|
System.Generics.Collections,
|
|
System.RTTI,
|
|
FireDAC.DApt,
|
|
Data.DB,
|
|
FireDAC.Comp.Client,
|
|
FireDAC.Stan.Def,
|
|
FireDAC.Stan.Pool,
|
|
FireDAC.Stan.Async,
|
|
FireDAC.Stan.Param,
|
|
MVCFramework,
|
|
MVCFramework.Commons,
|
|
MVCFramework.RQL.Parser,
|
|
MVCFramework.Cache,
|
|
MVCFramework.Serializer.Intf,
|
|
MVCFramework.Serializer.Commons,
|
|
System.SyncObjs,
|
|
System.TypInfo;
|
|
|
|
type
|
|
EMVCActiveRecord = class(EMVCException)
|
|
public
|
|
constructor Create(const AMsg: string); reintroduce; { do not override!! }
|
|
end;
|
|
|
|
EMVCActiveRecordNotFound = class(EMVCActiveRecord)
|
|
public
|
|
procedure AfterConstruction; override;
|
|
end;
|
|
|
|
EMVCActiveRecordVersionedItemNotFound = class(EMVCActiveRecordNotFound)
|
|
end;
|
|
|
|
EMVCActiveRecordTransactionContext = class(EMVCActiveRecord)
|
|
end;
|
|
|
|
|
|
TMVCActiveRecordClass = class of TMVCActiveRecord;
|
|
TMVCActiveRecord = class;
|
|
|
|
{$IF Defined(CUSTOM_MANAGED_RECORDS)}
|
|
TMVCTransactionContext = record
|
|
private
|
|
fConnection: TFDConnection;
|
|
public
|
|
class operator Finalize(var Dest: TMVCTransactionContext);
|
|
class operator Assign (var Dest: TMVCTransactionContext; const [ref] Src: TMVCTransactionContext);
|
|
constructor Create(Dummy: Integer); overload;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
TMVCActiveRecordFieldOption = (
|
|
/// <summary>
|
|
/// It's the primary key of the mapped table }
|
|
/// </summary>
|
|
foPrimaryKey,
|
|
/// <summary>
|
|
/// Not written, read - similar to readonly - is updated after insert and update
|
|
/// </summary>
|
|
foAutoGenerated,
|
|
/// <summary>
|
|
/// shortcut for --> Insertable := False; Updatable := False; Selectable := True;
|
|
/// </summary>
|
|
foReadOnly,
|
|
/// <summary>
|
|
/// used for versioning, only one field with foVersion is allowed in class
|
|
/// </summary>
|
|
foVersion,
|
|
/// <summary>
|
|
/// not included in SQL SELECT commands
|
|
/// </summary>
|
|
foDoNotSelect,
|
|
/// <summary>
|
|
/// not included in SQL INSERT commands
|
|
/// </summary>
|
|
foDoNotInsert,
|
|
/// <summary>
|
|
/// not included in SQL UPDATE commands
|
|
/// </summary>
|
|
foDoNotUpdate
|
|
);
|
|
|
|
|
|
|
|
|
|
TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption;
|
|
TMVCEntityAction = (eaCreate, eaRetrieve, eaUpdate, eaDelete);
|
|
TMVCEntityActions = set of TMVCEntityAction;
|
|
TMVCActiveRecordLoadOption = (loIgnoreNotExistentFields);
|
|
TMVCActiveRecordLoadOptions = set of TMVCActiveRecordLoadOption;
|
|
|
|
TPartitionFieldNames = class(TList<String>)
|
|
end;
|
|
|
|
TPartitionFieldValues = class(TList<String>)
|
|
end;
|
|
|
|
TPartitionFieldTypes = class(TList<TFieldType>)
|
|
end;
|
|
|
|
IMVCEntityProcessor = interface
|
|
['{E7CD11E6-9FF9-46D2-B7B0-DA5B38EAA14E}']
|
|
procedure GetEntities(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
|
|
var Handled: Boolean);
|
|
procedure GetEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
|
|
const id: Integer; var Handled: Boolean);
|
|
procedure CreateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
|
|
var Handled: Boolean);
|
|
procedure UpdateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
|
|
const id: Integer; var Handled: Boolean);
|
|
procedure DeleteEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
|
|
const id: Integer; var Handled: Boolean);
|
|
end;
|
|
|
|
TFieldInfo = class
|
|
public
|
|
FieldName: string;
|
|
FieldOptions: TMVCActiveRecordFieldOptions;
|
|
DataTypeName: string;
|
|
Selectable, Insertable, Updatable, IsVersion: Boolean;
|
|
procedure EndUpdates;
|
|
end;
|
|
|
|
TSQLQueryWithName = record
|
|
Name: String;
|
|
SQLText: String;
|
|
BackEnd: String; //TMVCActiveRecordBackEnd
|
|
end;
|
|
|
|
TRQLQueryWithName = record
|
|
Name: String;
|
|
RQLText: String;
|
|
end;
|
|
|
|
|
|
TFieldsMap = class(TObjectDictionary<TRTTIField, TFieldInfo>)
|
|
private
|
|
fWritableFieldsCount: Integer;
|
|
fReadableFieldsCount: Integer;
|
|
public
|
|
constructor Create;
|
|
procedure EndUpdates;
|
|
property WritableFieldsCount: Integer read fWritableFieldsCount;
|
|
property ReadableFieldsCount: Integer read fReadableFieldsCount;
|
|
function GetInfoByFieldName(const FieldName: string): TFieldInfo;
|
|
end;
|
|
|
|
MVCActiveRecordCustomAttribute = class(TCustomAttribute)
|
|
|
|
end;
|
|
|
|
MVCTableAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
Name: string;
|
|
RQLFilter: string;
|
|
constructor Create(aName: string); overload;
|
|
constructor Create(aName: string; aRQLFilter: String); overload;
|
|
end;
|
|
|
|
MVCPartitionAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
PartitionClause: String;
|
|
constructor Create(const PartitionClause: String);
|
|
end;
|
|
|
|
MVCNamedSQLQueryAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
Name: string;
|
|
SQLQuery: String;
|
|
Backend: String; //TMVCActiveRecordBackEnd
|
|
constructor Create(aName: string; aSQLSelect: String); overload;
|
|
constructor Create(aName: string; aSQLSelect: String; aBackEnd: String); overload;
|
|
end;
|
|
|
|
MVCNamedRQLQueryAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
Name: string;
|
|
RQLQuery: String;
|
|
constructor Create(aName: string; aRQL: String);
|
|
end;
|
|
|
|
MVCTableFieldAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
FieldName: string;
|
|
FieldOptions: TMVCActiveRecordFieldOptions;
|
|
SequenceName, DataTypeName: string;
|
|
constructor Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions;
|
|
const aSequenceName: string = ''; const aDataTypeName: string = ''); overload;
|
|
constructor Create(aFieldName: string; const aDataTypeName: string = ''); overload;
|
|
end;
|
|
|
|
MVCPrimaryKeyAttribute = MVCTableFieldAttribute deprecated '(ERROR) Use MVCTableFieldAttribute';
|
|
|
|
MVCEntityActionsAttribute = class(MVCActiveRecordCustomAttribute)
|
|
private
|
|
EntityAllowedActions: TMVCEntityActions;
|
|
public
|
|
constructor Create(const aEntityAllowedActions: TMVCEntityActions);
|
|
|
|
end;
|
|
|
|
TMVCSQLGenerator = class;
|
|
|
|
TPartitionInfo = class
|
|
private
|
|
class
|
|
var PartitionInfoCache: TMVCThreadedObjectCache<TPartitionInfo>;
|
|
private
|
|
fRQLFilter: String;
|
|
fSQLFilter: String;
|
|
fFieldValues: TPartitionFieldValues;
|
|
fFieldTypes: TPartitionFieldTypes;
|
|
fFieldNames: TPartitionFieldNames;
|
|
public
|
|
property FieldNames: TPartitionFieldNames read fFieldNames;
|
|
property FieldValues: TPartitionFieldValues read fFieldValues;
|
|
property FieldTypes: TPartitionFieldTypes read fFieldTypes;
|
|
property RQLFilter: String read fRQLFilter;
|
|
property SQLFilter: String read fSQLFilter;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
class constructor Create;
|
|
class destructor Destroy;
|
|
procedure InitializeFilterStrings(const RQLCompiler: TRQLCompiler);
|
|
class function BuildPartitionClause(const PartitionClause: String; const RQLCompilerClass: TRQLCompilerClass): TPartitionInfo;
|
|
end;
|
|
|
|
TMVCActiveRecordList = class(TObjectList<TMVCActiveRecord>)
|
|
public
|
|
constructor Create; virtual;
|
|
end;
|
|
|
|
TMVCTableMap = class
|
|
private
|
|
fVersionRTTIField: TRttiField;
|
|
fVersionFieldName: String;
|
|
public
|
|
fPartitionInfoInternal: TPartitionInfo;
|
|
fEntityAllowedActions: TMVCEntityActions;
|
|
fTableName: String;
|
|
fIsVersioned: Boolean;
|
|
fPartitionClause: String;
|
|
fRTTIType: TRttiInstanceType;
|
|
fObjAttributes: TArray<TCustomAttribute>;
|
|
fDefaultRQLFilter: string;
|
|
fMap: TFieldsMap;
|
|
fPrimaryKey: TRTTIField;
|
|
fPrimaryKeyInInsert: Boolean;
|
|
fMapping: TMVCFieldsMapping;
|
|
fPropsAttributes: TArray<TCustomAttribute>;
|
|
fProps: TArray<TRTTIField>;
|
|
fPrimaryKeyFieldName: string;
|
|
fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
|
|
fPrimaryKeySequenceName: string;
|
|
fPrimaryKeyFieldType: TFieldType;
|
|
fNamedSQLQueries: TArray<TSQLQueryWithName>;
|
|
fNamedRQLQueries: TArray<TRQLQueryWithName>;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function VersionValueAsInt64For(AR: TMVCActiveRecord): Int64; //inline;
|
|
end;
|
|
|
|
TMVCActiveRecord = class
|
|
private
|
|
fChildren: TObjectList<TObject>;
|
|
fConn: TFDConnection;
|
|
fSQLGenerator: TMVCSQLGenerator;
|
|
fRQL2SQL: TRQL2SQL;
|
|
procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam);
|
|
function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
|
|
function GetPrimaryKeyIsAutogenerated: Boolean;
|
|
procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
|
|
function GetAttributes(const AttrName: string): TValue;
|
|
procedure SetAttributes(const AttrName: string; const Value: TValue);
|
|
function GetTableName: string;
|
|
procedure AdvanceVersioning(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord);
|
|
procedure SetInitialObjVersion(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord);
|
|
protected
|
|
fBackendDriver: string;
|
|
fTableMap: TMVCTableMap;
|
|
function GetCustomTableName: String; virtual;
|
|
function GetPartitionInfo: TPartitionInfo;
|
|
function GetConnection: TFDConnection;
|
|
procedure InitTableInfo(const aTableName: String);
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const Unidirectional: Boolean;
|
|
const DirectExecute: Boolean): TDataSet; overload;
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const Connection: TFDConnection;
|
|
const Unidirectional: Boolean;
|
|
const DirectExecute: Boolean)
|
|
: TDataSet; overload;
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType;
|
|
const Unidirectional: Boolean;
|
|
const DirectExecute: Boolean)
|
|
: TDataSet; overload;
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType;
|
|
const Connection: TFDConnection;
|
|
const Unidirectional: Boolean;
|
|
const DirectExecute: Boolean): TDataSet; overload;
|
|
procedure FillPrimaryKey(const SequenceName: string);
|
|
function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): Int64;
|
|
overload;
|
|
class function GetByPK(aActiveRecord: TMVCActiveRecord; const aValue: string; const aFieldType: TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord; overload;
|
|
|
|
|
|
// load events
|
|
/// <summary>
|
|
/// Called everywhere before persist object into database
|
|
/// </summary>
|
|
procedure OnValidation(const EntityAction: TMVCEntityAction); virtual;
|
|
|
|
/// <summary>
|
|
/// Called just after load the object state from database
|
|
/// </summary>
|
|
procedure OnAfterLoad; virtual;
|
|
|
|
/// <summary>
|
|
/// Called before load the object state from database
|
|
/// </summary>
|
|
procedure OnBeforeLoad; virtual;
|
|
|
|
/// <summary>
|
|
/// Called before insert the object state to database
|
|
/// </summary>
|
|
procedure OnBeforeInsert; virtual;
|
|
|
|
/// <summary>
|
|
/// Called after insert the object state to database
|
|
/// </summary>
|
|
procedure OnAfterInsert; virtual;
|
|
|
|
/// <summary>
|
|
/// Called before update the object state to database
|
|
/// </summary>
|
|
procedure OnBeforeUpdate; virtual;
|
|
|
|
/// <summary>
|
|
/// Called after update the object state to database
|
|
/// </summary>
|
|
procedure OnAfterUpdate; virtual;
|
|
|
|
/// <summary>
|
|
/// Called before delete object from database
|
|
/// </summary>
|
|
procedure OnBeforeDelete; virtual;
|
|
|
|
/// <summary>
|
|
/// Called after delete object from database
|
|
/// </summary>
|
|
procedure OnAfterDelete; virtual;
|
|
|
|
/// <summary>
|
|
/// Called before insert or update the object to the database
|
|
/// </summary>
|
|
procedure OnBeforeInsertOrUpdate; virtual;
|
|
|
|
/// <summary>
|
|
/// Called before execute sql
|
|
/// </summary>
|
|
procedure OnBeforeExecuteSQL(var SQL: string); virtual;
|
|
|
|
/// <summary>
|
|
/// Called after insert or update the object to the database
|
|
/// </summary>
|
|
procedure OnAfterInsertOrUpdate; virtual;
|
|
|
|
procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
|
|
procedure MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
|
|
var Handled: Boolean); virtual;
|
|
|
|
function GenerateSelectSQL: string;
|
|
|
|
function SQLGenerator: TMVCSQLGenerator;
|
|
function InternalCount(const RQL: string): Int64;
|
|
function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer)
|
|
: TMVCActiveRecordList; overload;
|
|
function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer;
|
|
const OutList: TMVCActiveRecordList): UInt32; overload;
|
|
public
|
|
constructor Create(aLazyLoadConnection: Boolean); overload; // cannot be virtual!
|
|
constructor Create; overload; virtual;
|
|
destructor Destroy; override;
|
|
procedure EnsureConnection;
|
|
procedure Assign(ActiveRecord: TMVCActiveRecord); virtual;
|
|
procedure InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
|
|
function GetBackEnd: string;
|
|
/// <summary>
|
|
/// Executes an Insert (pk is null) or an Update (pk is not null)
|
|
/// </summary>
|
|
procedure Store;
|
|
/// <summary>
|
|
/// Reload the current instance from database if the primary key is not empty.
|
|
/// </summary>
|
|
procedure Refresh; virtual;
|
|
function CheckAction(const aEntityAction: TMVCEntityAction;
|
|
const aRaiseException: Boolean = True): Boolean;
|
|
procedure Insert;
|
|
function GetMapping: TMVCFieldsMapping;
|
|
function LoadByPK(const id: Int64): Boolean; overload; virtual;
|
|
function LoadByPK(const id: string): Boolean; overload; virtual;
|
|
function LoadByPK(const id: TGuid): Boolean; overload; virtual;
|
|
function LoadByPK(const id: string; const aFieldType: TFieldType): Boolean; overload; virtual;
|
|
procedure Update(const RaiseExceptionIfNotFound: Boolean = True);
|
|
procedure Delete(const RaiseExceptionIfNotFound: Boolean = True);
|
|
function TableInfo: string;
|
|
procedure LoadByDataset(const aDataSet: TDataSet;
|
|
const aOptions: TMVCActiveRecordLoadOptions = []);
|
|
procedure SetPK(const aValue: TValue);
|
|
procedure SetPropertyValue(const aProp: TRttiProperty; const aValue: TValue);
|
|
function GetPK: TValue;
|
|
function TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean;
|
|
function PKIsNullable(out PKValue: TValue): Boolean;
|
|
function PKIsNull: Boolean;
|
|
procedure AddChildren(const ChildObject: TObject);
|
|
procedure RemoveChildren(const ChildObject: TObject);
|
|
function GetPrimaryKeyFieldType: TFieldType;
|
|
|
|
function FindSQLQueryByName(const QueryName: String; out NamedSQLQuery: TSQLQueryWithName): Boolean;
|
|
function FindRQLQueryByName(const QueryName: String; out NamedRQLQuery: TRQLQueryWithName): Boolean;
|
|
|
|
property Attributes[const AttrName: string]: TValue
|
|
read GetAttributes
|
|
write SetAttributes;
|
|
|
|
[MVCDoNotSerialize]
|
|
property TableName: string
|
|
read GetTableName;
|
|
|
|
[MVCDoNotSerialize]
|
|
property PrimaryKeyIsAutogenerated: Boolean
|
|
read GetPrimaryKeyIsAutogenerated
|
|
write SetPrimaryKeyIsAutogenerated;
|
|
|
|
class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
|
|
class function CurrentConnection: TFDConnection;
|
|
end;
|
|
|
|
IMVCUnitOfWork<T: TMVCActiveRecord> = interface
|
|
['{68B55DD3-57F6-4CC0-A4DE-BFDE7C3AA287}']
|
|
procedure RegisterDelete(const Value: T); overload;
|
|
procedure RegisterDelete(const Enumerable: TEnumerable<T>); overload;
|
|
procedure RegisterUpdate(const Value: T);
|
|
procedure RegisterInsert(const Value: T);
|
|
procedure UnregisterDelete(const Value: T);
|
|
procedure UnregisterUpdate(const Value: T);
|
|
procedure UnregisterInsert(const Value: T);
|
|
end;
|
|
|
|
TMVCItemApplyAction<T: TMVCActiveRecord> = reference to procedure(const Obj: T;
|
|
const EntityAction: TMVCEntityAction; var Handled: Boolean);
|
|
|
|
TMergeModeItem = (mmInsert, mmUpdate, mmDelete);
|
|
TMergeMode = set of TMergeModeItem;
|
|
|
|
IMVCMultiExecutor<T: TMVCActiveRecord> = interface
|
|
['{C815246B-19CA-4F6C-AA67-8E491F809340}']
|
|
procedure Apply(const ItemApplyAction: TMVCItemApplyAction<T> = nil);
|
|
end;
|
|
|
|
TMVCActiveRecordHelper = class helper for TMVCActiveRecord
|
|
{ GetByPK }
|
|
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: Int64;
|
|
const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
|
|
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
|
|
const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
|
|
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: TGuid;
|
|
const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
|
|
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string; const aFieldType: TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean): T; overload;
|
|
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: Int64;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: TGuid;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
|
|
{ Select }
|
|
/// <summary>
|
|
/// Returns a TObjectList<TMVCActiveRecord> from a SQL using variant params
|
|
/// </summary>
|
|
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
|
|
/// <summary>
|
|
/// Returns a TObjectList<TMVCActiveRecord> from a SQL using typed params
|
|
/// </summary>
|
|
class function Select<T: TMVCActiveRecord, constructor>(
|
|
const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions = [])
|
|
: TObjectList<T>; overload;
|
|
/// <summary>
|
|
/// Returns a TMVCActiveRecordList from a SQL using typed params and class ref
|
|
/// </summary>
|
|
class function Select(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass;
|
|
const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions = [])
|
|
: TMVCActiveRecordList; overload;
|
|
/// <summary>
|
|
/// Fills a TObjectList<TMVCActiveRecord> from a SQL using typed params.
|
|
/// Returns number of the records in the list (not only the selected records, but the current .Count of the list)
|
|
/// </summary>
|
|
class function Select<T: TMVCActiveRecord, constructor>(
|
|
const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions;
|
|
const OutList: TObjectList<T>): UInt32; overload;
|
|
|
|
class function Select(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass;
|
|
const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions;
|
|
const OutList: TMVCActiveRecordList): UInt32; overload;
|
|
|
|
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant)
|
|
: TMVCActiveRecordList; overload;
|
|
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant;
|
|
const Connection: TFDConnection): TMVCActiveRecordList; overload;
|
|
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant;
|
|
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; overload;
|
|
|
|
{ SelectOne }
|
|
class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = [];
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
|
|
|
|
{ SelectRQL }
|
|
function SelectRQL(const RQL: string; const MaxRecordCount: Integer)
|
|
: TMVCActiveRecordList; overload;
|
|
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
|
|
const MaxRecordCount: Integer)
|
|
: TObjectList<T>; overload;
|
|
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
|
|
const MaxRecordCount: Integer; const OutList: TObjectList<T>): UInt32; overload;
|
|
class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
|
|
const MaxRecordCount: Integer)
|
|
: TMVCActiveRecordList; overload;
|
|
class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
|
|
const MaxRecordCount: Integer; const OutList: TMVCActiveRecordList): UInt32; overload;
|
|
|
|
{ Misc }
|
|
class function All<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
|
|
class function DeleteRQL<T: TMVCActiveRecord>(const RQL: string = ''): Int64; overload;
|
|
class function Count<T: TMVCActiveRecord>(const RQL: string = ''): Int64; overload;
|
|
{$IF Defined(CUSTOM_MANAGED_RECORDS)}
|
|
class function UseTransactionContext: TMVCTransactionContext;
|
|
{$ENDIF}
|
|
|
|
{ Where }
|
|
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant)
|
|
: TObjectList<T>; overload;
|
|
/// <summary>
|
|
/// Executes a SQL select using the SQLWhere parameter as where clause. This method is partitioning safe.
|
|
/// Returns TObjectList<EntityType>.
|
|
/// </summary>
|
|
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType): TObjectList<T>; overload;
|
|
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const OutList: TObjectList<T>): UInt32; overload;
|
|
class function Where(
|
|
const aClass: TMVCActiveRecordClass;
|
|
const SQLWhere: string;
|
|
const Params: array of Variant)
|
|
: TMVCActiveRecordList; overload;
|
|
class function Where(
|
|
const aClass: TMVCActiveRecordClass;
|
|
const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const Connection: TFDConnection): TMVCActiveRecordList; overload;
|
|
class function Where(
|
|
const aClass: TMVCActiveRecordClass;
|
|
const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const Connection: TFDConnection;
|
|
const OutList: TMVCActiveRecordList): UInt32; overload;
|
|
|
|
{ GetXXXByWhere }
|
|
class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant; const ParamTypes: array of TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant; const ParamTypes: array of TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
|
|
{ Merge }
|
|
class function Merge<T: TMVCActiveRecord>(CurrentList,
|
|
NewList: TObjectList<T>; const MergeMode: TMergeMode = [mmInsert, mmUpdate, mmDelete]): IMVCMultiExecutor<T>;
|
|
|
|
{ Misc }
|
|
class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
|
|
overload;
|
|
class function All(const aQualifiedClassName: String): TObjectList<TMVCActiveRecord>;
|
|
overload;
|
|
class function DeleteAll(const aClass: TMVCActiveRecordClass): Int64; overload;
|
|
class function DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): Int64; overload;
|
|
function Count(const RQL: string = ''): Int64; overload;
|
|
class function Count(const aClass: TMVCActiveRecordClass; const RQL: string = '')
|
|
: int64; overload;
|
|
|
|
{ SelectDataSet }
|
|
class function SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const Unidirectional: Boolean = False;
|
|
const DirectExecute: Boolean = False): TDataSet; overload;
|
|
class function SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Unidirectional: Boolean = False;
|
|
const DirectExecute: Boolean = False): TDataSet; overload;
|
|
|
|
{ NamedQuery}
|
|
class function SelectByNamedQuery<T: TMVCActiveRecord, constructor>(
|
|
const QueryName: String;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
|
|
class function SelectByNamedQuery(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass;
|
|
const QueryName: String;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions = []): TMVCActiveRecordList; overload;
|
|
class function SelectRQLByNamedQuery<T: constructor, TMVCActiveRecord>(
|
|
const QueryName: String;
|
|
const Params: array of const;
|
|
const MaxRecordCount: Integer): TObjectList<T>; overload;
|
|
class function SelectRQLByNamedQuery(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass;
|
|
const QueryName: String;
|
|
const Params: array of const;
|
|
const MaxRecordCount: Integer): TMVCActiveRecordList; overload;
|
|
class function DeleteRQLByNamedQuery<T: TMVCActiveRecord, constructor>(
|
|
const QueryName: String;
|
|
const Params: array of const): Int64;
|
|
class function CountRQLByNamedQuery<T: TMVCActiveRecord, constructor>(
|
|
const QueryName: string;
|
|
const Params: array of const): Int64;
|
|
class function TryGetSQLQuery<T: TMVCActiveRecord, constructor>(
|
|
const QueryName: String;
|
|
out NamedSQLQuery: TSQLQueryWithName): Boolean; overload;
|
|
class function TryGetRQLQuery<T: TMVCActiveRecord, constructor>(
|
|
const QueryName: String; out NamedRQLQuery: TRQLQueryWithName): Boolean;
|
|
{ RTTI }
|
|
class function CreateMVCActiveRecord<T: TMVCActiveRecord>(AQualifiedClassName: string; const AParams: TArray<TValue> = nil): T;
|
|
end;
|
|
|
|
TMVCEntityMapping = TPair<String, TMVCActiveRecordClass>;
|
|
|
|
IMVCEntitiesRegistry = interface
|
|
['{BB227BEB-A74A-4637-8897-B13BA938C07B}']
|
|
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
|
|
procedure AddEntityProcessor(const aURLSegment: string;
|
|
const aEntityProcessor: IMVCEntityProcessor);
|
|
function FindEntityClassByURLSegment(const aURLSegment: string;
|
|
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
|
|
function FindProcessorByURLSegment(const aURLSegment: string;
|
|
out aMVCEntityProcessor: IMVCEntityProcessor)
|
|
: Boolean;
|
|
function GetEntities: TArray<String>;
|
|
function GetURLSegmentWithEntities: TArray<TMVCEntityMapping>;
|
|
end;
|
|
|
|
TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry)
|
|
private
|
|
fEntitiesDict: TDictionary<string, TMVCActiveRecordClass>;
|
|
fProcessorsDict: TDictionary<string, IMVCEntityProcessor>;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
protected
|
|
procedure AddEntityProcessor(const aURLSegment: string; const aEntityProcessor: IMVCEntityProcessor);
|
|
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
|
|
function FindEntityClassByURLSegment(const aURLSegment: string;
|
|
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
|
|
function FindProcessorByURLSegment(const aURLSegment: string; out aMVCEntityProcessor: IMVCEntityProcessor)
|
|
: Boolean;
|
|
function GetEntities: TArray<String>;
|
|
function GetURLSegmentWithEntities: TArray<TMVCEntityMapping>;
|
|
end;
|
|
|
|
IMVCActiveRecordTableMap = interface
|
|
['{517A863F-8BAD-4F66-A520-205149228360}']
|
|
procedure AddTableMap(const AR: TMVCActiveRecord; const TableName: String; var TableMap: TMVCTableMap);
|
|
function TryGetValue(const AR: TMVCActiveRecord; const TableName: String; out TableMap: TMVCTableMap): Boolean;
|
|
procedure ExecWithExclusiveLock(Proc: TProc<IMVCActiveRecordTableMap>);
|
|
procedure FlushCache;
|
|
end;
|
|
|
|
IMVCActiveRecordConnections = interface
|
|
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
|
|
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false); overload;
|
|
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); overload;
|
|
procedure AddDefaultConnection(const aConnectionDefName: String); overload;
|
|
procedure AddConnection(const aName, aConnectionDefName: String); overload;
|
|
procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True);
|
|
procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
|
|
procedure SetCurrent(const aName: string);
|
|
function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
|
|
function GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
|
|
function GetCurrentBackend: string;
|
|
procedure SetDefault;
|
|
end;
|
|
|
|
TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnections)
|
|
private type
|
|
TConnHolder = class
|
|
public
|
|
Connection: TFDConnection;
|
|
OwnsConnection: Boolean;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
var
|
|
fMREW: TMultiReadExclusiveWriteSynchronizer;
|
|
fConnectionsDict: TDictionary<string, TConnHolder>;
|
|
fCurrentConnectionsByThread: TDictionary<TThreadID, string>;
|
|
function GetKeyName(const aName: string): string;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
|
|
procedure AddConnection(const aName, aConnectionDefName: String); overload;
|
|
procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
|
|
procedure AddDefaultConnection(const aConnectionDefName: String); overload;
|
|
procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True);
|
|
procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
|
|
procedure SetCurrent(const aName: string);
|
|
function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
|
|
function GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
|
|
function GetByName(const aName: string): TFDConnection;
|
|
function GetCurrentBackend: string;
|
|
procedure SetDefault;
|
|
end;
|
|
|
|
|
|
TMVCTableMapRepository = class(TInterfacedObject, IMVCActiveRecordTableMap)
|
|
private
|
|
fMREW: TMultiReadExclusiveWriteSynchronizer;
|
|
fTableMapDict: TObjectDictionary<String, TMVCTableMap>;
|
|
function GetCacheKey(const AR: TMVCActiveRecord; const TableName: String): String; inline;
|
|
protected
|
|
procedure AddTableMap(const AR: TMVCActiveRecord; const TableName: String; var TableMap: TMVCTableMap);
|
|
function TryGetValue(const AR: TMVCActiveRecord; const TableName: String; out TableMap: TMVCTableMap): Boolean;
|
|
procedure ExecWithExclusiveLock(Proc: TProc<IMVCActiveRecordTableMap>);
|
|
procedure FlushCache;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
TMVCSQLGenerator = class abstract
|
|
private
|
|
fMapping: TMVCFieldsMapping;
|
|
fDefaultSQLFilter: String;
|
|
fDefaultRQLFilter: String;
|
|
fCompiler: TRQLCompiler;
|
|
fRQL2SQL: TRQL2SQL;
|
|
protected
|
|
fPartitionInfo: TPartitionInfo;
|
|
function GetDefaultSQLFilter(const IncludeWhereClause: Boolean; const IncludeAndClauseBeforeFilter: Boolean = false)
|
|
: String; // inline;
|
|
function MergeDefaultRQLFilter(const RQL: String): String; // inline;
|
|
function MergeSQLFilter(const PartitionSQL, FilteringSQL: String): String;
|
|
function GetRQLParser: TRQL2SQL;
|
|
function GetCompiler: TRQLCompiler;
|
|
function GetCompilerClass: TRQLCompilerClass; virtual; abstract;
|
|
function GetMapping: TMVCFieldsMapping;
|
|
function TableFieldsDelimited(const Map: TFieldsMap; const PKFieldName: string; const Delimiter: string): string;
|
|
public
|
|
constructor Create(Mapping: TMVCFieldsMapping; const DefaultRQLFilter: string;
|
|
const PartitionInfo: TPartitionInfo); virtual;
|
|
destructor Destroy; override;
|
|
// capabilities
|
|
function HasSequences: Boolean; virtual;
|
|
function HasReturning: Boolean; virtual;
|
|
function HasNativeUUID: Boolean; virtual;
|
|
// end-capabilities
|
|
|
|
// abstract SQL generator methods
|
|
function CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping;
|
|
const UseArtificialLimit: Boolean = True; const UseFilterOnly: Boolean = false;
|
|
const MaxRecordCount: Int32 = TMVCConstants.MAX_RECORD_COUNT): string;
|
|
function CreateSelectSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
|
|
function CreateInsertSQL(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord): string; virtual; abstract;
|
|
|
|
// virtual methods with default implementation
|
|
function CreateSelectByPKSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
|
|
function CreateDeleteSQL(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord): string; virtual;
|
|
function CreateDeleteAllSQL(const TableName: string): string; virtual;
|
|
function CreateSelectCount(const TableName: string): string; virtual;
|
|
function CreateUpdateSQL(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord): string; virtual;
|
|
function GetSequenceValueSQL(const PKFieldName: string; const SequenceName: string; const Step: Integer = 1)
|
|
: string; virtual;
|
|
|
|
// Overwritten by descendant if the SQL syntaxt requires more than the simple table name
|
|
// or if the table name contains spaces.
|
|
function GetTableNameForSQL(const TableName: string): string; virtual;
|
|
// Overwritten by descendant if the SQL syntaxt requires more than the simple field name
|
|
// or if the field name contains spaces.
|
|
function GetFieldNameForSQL(const FieldName: string): string; virtual;
|
|
function GetParamNameForSQL(const FieldName: string): string; virtual;
|
|
// helper methods
|
|
class function RemoveInitialWhereKeyword(const SQLFilter: String): String;
|
|
end;
|
|
|
|
TMVCSQLGeneratorClass = class of TMVCSQLGenerator;
|
|
|
|
TMVCSQLGeneratorRegistry = class sealed
|
|
private
|
|
class var cInstance: TMVCSQLGeneratorRegistry;
|
|
|
|
class var
|
|
fSQLGenerators: TDictionary<string, TMVCSQLGeneratorClass>;
|
|
cConnectionsLock: TObject;
|
|
protected
|
|
constructor Create;
|
|
public
|
|
destructor Destroy; override;
|
|
class function Instance: TMVCSQLGeneratorRegistry;
|
|
class constructor Create;
|
|
class destructor Destroy;
|
|
procedure RegisterSQLGenerator(const aBackend: string; const aRQLBackendClass: TMVCSQLGeneratorClass);
|
|
procedure UnRegisterSQLGenerator(const aBackend: string);
|
|
function GetSQLGenerator(const aBackend: string): TMVCSQLGeneratorClass;
|
|
end;
|
|
|
|
TMVCUnitOfWork<T: TMVCActiveRecord> = class(TInterfacedObject, IMVCUnitOfWork<T>, IMVCMultiExecutor<T>)
|
|
private
|
|
fListToDelete: TObjectList<T>;
|
|
fListToUpdate: TObjectList<T>;
|
|
fListToInsert: TObjectList<T>;
|
|
protected
|
|
// multiexecutor
|
|
procedure Apply(const ItemApplyAction: TMVCItemApplyAction<T> = nil);
|
|
// unitofwork
|
|
procedure RegisterDelete(const Value: T); overload;
|
|
procedure RegisterDelete(const Enumerable: TEnumerable<T>); overload;
|
|
procedure RegisterUpdate(const Value: T);
|
|
procedure RegisterInsert(const Value: T);
|
|
procedure UnregisterDelete(const Value: T);
|
|
procedure UnregisterUpdate(const Value: T);
|
|
procedure UnregisterInsert(const Value: T);
|
|
|
|
// events
|
|
procedure DoItemApplyAction(const Obj: TMVCActiveRecord; const EntityAction: TMVCEntityAction;
|
|
const ItemApplyAction: TMVCItemApplyAction<T>; var Handled: Boolean);
|
|
|
|
class function KeyExistsInt(const NewList: TObjectList<T>; const KeyValue: Integer; out Index: Integer): Boolean;
|
|
class function KeyExistsInt64(const NewList: TObjectList<T>; const KeyValue: int64; out Index: Integer): Boolean;
|
|
class function KeyExistsString(const NewList: TObjectList<T>; const KeyValue: String; out Index: Integer): Boolean;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TMVCActiveRecordBackEnd = record
|
|
public
|
|
const
|
|
Unknown = 'unknown';
|
|
Oracle = 'oracle';
|
|
MSSql = 'mssql';
|
|
MSAccess = 'msaccess';
|
|
MySQL ='mysql';
|
|
DB2 = 'db2';
|
|
SQLAnywhere = 'sqlanywhere';
|
|
Advantage = 'advantage';
|
|
Interbase = 'interbase';
|
|
FirebirdSQL = 'firebird';
|
|
SQLite = 'sqlite';
|
|
PostgreSQL = 'postgresql';
|
|
NexusDB = 'nexusdb';
|
|
DataSnap = 'dataSnap';
|
|
Informix = 'informix';
|
|
Teradata = 'teradata';
|
|
MongoDB = 'mongodb';
|
|
Other = 'other';
|
|
end;
|
|
|
|
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
|
|
function ActiveRecordTableMapRegistry: IMVCActiveRecordTableMap;
|
|
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
|
|
function GetBackEndByConnection(aConnection: TFDConnection): string;
|
|
|
|
const
|
|
OBJECT_VERSION_STARTING_VALUE = '1';
|
|
OBJECT_VERSION_STARTING_VALUE_AS_INT: Int64 = 1;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.IOUtils,
|
|
System.Classes,
|
|
MVCFramework.DataSet.Utils,
|
|
MVCFramework.Logger,
|
|
MVCFramework.Nullables,
|
|
MVCFramework.RTTI.Utils,
|
|
FireDAC.Stan.Option,
|
|
Data.FmtBcd,
|
|
System.Variants,
|
|
System.Math;
|
|
|
|
var
|
|
gCtx: TRttiContext;
|
|
gEntitiesRegistry: IMVCEntitiesRegistry;
|
|
gConnections: IMVCActiveRecordConnections;
|
|
gTableMap: IMVCActiveRecordTableMap;
|
|
gTableMapLock: TObject;
|
|
|
|
function GetBackEndByConnection(aConnection: TFDConnection): string;
|
|
begin
|
|
if not aConnection.Connected then
|
|
begin
|
|
aConnection.Connected := True; {required to know the backend}
|
|
end;
|
|
|
|
case Ord(aConnection.RDBMSKind) of
|
|
0:
|
|
Exit(TMVCActiveRecordBackEnd.Unknown);
|
|
1:
|
|
Exit(TMVCActiveRecordBackEnd.Oracle);
|
|
2:
|
|
Exit(TMVCActiveRecordBackEnd.MSSql);
|
|
3:
|
|
Exit(TMVCActiveRecordBackEnd.MSAccess);
|
|
4:
|
|
Exit(TMVCActiveRecordBackEnd.MySQL);
|
|
5:
|
|
Exit(TMVCActiveRecordBackEnd.DB2);
|
|
6:
|
|
Exit(TMVCActiveRecordBackEnd.SQLAnywhere);
|
|
7:
|
|
Exit(TMVCActiveRecordBackEnd.Advantage);
|
|
8:
|
|
Exit(TMVCActiveRecordBackEnd.Interbase);
|
|
9:
|
|
Exit(TMVCActiveRecordBackEnd.FirebirdSQL);
|
|
10:
|
|
Exit(TMVCActiveRecordBackEnd.SQLite);
|
|
11:
|
|
Exit(TMVCActiveRecordBackEnd.PostgreSQL);
|
|
12:
|
|
Exit(TMVCActiveRecordBackEnd.NexusDB);
|
|
13:
|
|
Exit(TMVCActiveRecordBackEnd.DataSnap);
|
|
14:
|
|
Exit(TMVCActiveRecordBackEnd.Informix);
|
|
15:
|
|
Exit(TMVCActiveRecordBackEnd.Teradata);
|
|
16:
|
|
Exit(TMVCActiveRecordBackEnd.MongoDB);
|
|
17:
|
|
Exit(TMVCActiveRecordBackEnd.Other);
|
|
else
|
|
raise EMVCActiveRecord.Create('Unknown RDBMS Kind');
|
|
end;
|
|
end;
|
|
|
|
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
|
|
begin
|
|
if gConnections = nil then // double check here
|
|
begin
|
|
TMonitor.Enter(gLock);
|
|
try
|
|
if gConnections = nil then
|
|
begin
|
|
gConnections := TMVCConnectionsRepository.Create;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(gLock);
|
|
end;
|
|
end;
|
|
Result := gConnections;
|
|
end;
|
|
|
|
function ActiveRecordTableMapRegistry: IMVCActiveRecordTableMap;
|
|
begin
|
|
if gTableMap = nil then // double check here
|
|
begin
|
|
TMonitor.Enter(gTableMapLock);
|
|
try
|
|
if gTableMap = nil then
|
|
begin
|
|
gTableMap := TMVCTableMapRepository.Create;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(gTableMapLock);
|
|
end;
|
|
end;
|
|
Result := gTableMap;
|
|
end;
|
|
|
|
|
|
function IntToNullableInt(const Value: Integer): NullableInt32;
|
|
begin
|
|
Result.SetValue(Value);
|
|
end;
|
|
|
|
{ TConnectionsRepository }
|
|
|
|
procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TFDConnection;
|
|
const aOwns: Boolean = false);
|
|
var
|
|
lName: string;
|
|
lConnKeyName: string;
|
|
lConnHolder: TConnHolder;
|
|
begin
|
|
lName := aName.ToLower;
|
|
lConnKeyName := GetKeyName(lName);
|
|
|
|
{ If the transaction is not started, initialize TxIsolation as ReadCommitted }
|
|
if aConnection.Transaction = nil then
|
|
begin
|
|
{ needed for Delphi 10.4 Sydney+ }
|
|
aConnection.TxOptions.Isolation := TFDTxIsolation.xiReadCommitted;
|
|
end;
|
|
|
|
fMREW.BeginWrite;
|
|
try
|
|
lConnHolder := TConnHolder.Create;
|
|
lConnHolder.Connection := aConnection;
|
|
lConnHolder.OwnsConnection := aOwns;
|
|
fConnectionsDict.Add(lConnKeyName, lConnHolder);
|
|
// raise exception on duplicates
|
|
if (lName = 'default') and (not fCurrentConnectionsByThread.ContainsKey(TThread.CurrentThread.ThreadID)) then
|
|
begin
|
|
fCurrentConnectionsByThread.AddOrSetValue(TThread.CurrentThread.ThreadID, lName);
|
|
end;
|
|
finally
|
|
fMREW.EndWrite;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean);
|
|
begin
|
|
AddConnection('default', aConnection, aOwns);
|
|
end;
|
|
|
|
procedure TMVCConnectionsRepository.AddConnection(const aName,
|
|
aConnectionDefName: String);
|
|
var
|
|
lConn: TFDConnection;
|
|
begin
|
|
lConn := TFDConnection.Create(nil);
|
|
try
|
|
lConn.ConnectionDefName := aConnectionDefName;
|
|
AddConnection(aName, lConn, True);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
lConn.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnectionDefName: String);
|
|
begin
|
|
AddConnection('default', aConnectionDefName);
|
|
end;
|
|
|
|
constructor TMVCConnectionsRepository.Create;
|
|
begin
|
|
inherited;
|
|
fMREW := TMultiReadExclusiveWriteSynchronizer.Create;
|
|
fConnectionsDict := TDictionary<string, TConnHolder>.Create;
|
|
fCurrentConnectionsByThread := TDictionary<TThreadID, string>.Create;
|
|
end;
|
|
|
|
destructor TMVCConnectionsRepository.Destroy;
|
|
begin
|
|
fConnectionsDict.Free;
|
|
fCurrentConnectionsByThread.Free;
|
|
fMREW.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TMVCConnectionsRepository.GetByName(const aName: string): TFDConnection;
|
|
var
|
|
lKeyName: string;
|
|
lConnHolder: TConnHolder;
|
|
begin
|
|
{$IF not Defined(TokyoOrBetter)}
|
|
Result := nil;
|
|
{$ENDIF}
|
|
lKeyName := GetKeyName(aName.ToLower);
|
|
fMREW.BeginRead;
|
|
try
|
|
if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
|
|
raise Exception.CreateFmt('Unknown connection %s', [aName]);
|
|
Result := lConnHolder.Connection;
|
|
finally
|
|
fMREW.EndRead;
|
|
end;
|
|
end;
|
|
|
|
function TMVCConnectionsRepository.GetCurrentConnectionName(
|
|
const RaiseExceptionIfNotAvailable: Boolean): String;
|
|
var
|
|
lName: string;
|
|
begin
|
|
{$IF not Defined(TokyoOrBetter)}
|
|
Result := '';
|
|
{$ENDIF}
|
|
fMREW.BeginRead;
|
|
try
|
|
if fCurrentConnectionsByThread.TryGetValue(TThread.CurrentThread.ThreadID, lName) then
|
|
begin
|
|
Result := lName;
|
|
end
|
|
else
|
|
begin
|
|
if RaiseExceptionIfNotAvailable then
|
|
raise EMVCActiveRecord.Create('No current connection for thread')
|
|
else
|
|
Result := '';
|
|
end;
|
|
finally
|
|
fMREW.EndRead;
|
|
end;
|
|
end;
|
|
|
|
function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean): TFDConnection;
|
|
var
|
|
lName: string;
|
|
begin
|
|
{$IF not Defined(TokyoOrBetter)}
|
|
Result := nil;
|
|
{$ENDIF}
|
|
fMREW.BeginRead;
|
|
try
|
|
if fCurrentConnectionsByThread.TryGetValue(TThread.CurrentThread.ThreadID, lName) then
|
|
begin
|
|
Result := GetByName(lName);
|
|
end
|
|
else
|
|
begin
|
|
if RaiseExceptionIfNotAvailable then
|
|
raise EMVCActiveRecord.Create('No current connection for thread')
|
|
else
|
|
Result := nil;
|
|
end;
|
|
finally
|
|
fMREW.EndRead;
|
|
end;
|
|
end;
|
|
|
|
function TMVCConnectionsRepository.GetCurrentBackend: string;
|
|
begin
|
|
Result := GetBackEndByConnection(GetCurrent);
|
|
end;
|
|
|
|
function TMVCConnectionsRepository.GetKeyName(const aName: string): string;
|
|
begin
|
|
Result := Format('%10.10d::%s', [TThread.CurrentThread.ThreadID, aName]);
|
|
end;
|
|
|
|
procedure TMVCConnectionsRepository.RemoveConnection(const aName: string;
|
|
const RaiseExceptionIfNotAvailable: Boolean = True);
|
|
var
|
|
lName: string;
|
|
lKeyName: string;
|
|
lConnHolder: TConnHolder;
|
|
begin
|
|
lName := aName.ToLower;
|
|
lKeyName := GetKeyName(lName);
|
|
|
|
fMREW.BeginWrite;
|
|
try
|
|
if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
|
|
begin
|
|
if RaiseExceptionIfNotAvailable then
|
|
begin
|
|
raise Exception.CreateFmt('Unknown connection %s', [aName])
|
|
end
|
|
else
|
|
begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
fConnectionsDict.Remove(lKeyName);
|
|
try
|
|
FreeAndNil(lConnHolder);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
LogE('ActiveRecord: ' + E.ClassName + ' > ' + E.Message);
|
|
raise;
|
|
end;
|
|
end;
|
|
fCurrentConnectionsByThread.Remove(TThread.CurrentThread.ThreadID);
|
|
finally
|
|
fMREW.EndWrite;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCConnectionsRepository.RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
|
|
begin
|
|
RemoveConnection('default', RaiseExceptionIfNotAvailable);
|
|
end;
|
|
|
|
procedure TMVCConnectionsRepository.SetCurrent(const aName: string);
|
|
var
|
|
lName: string;
|
|
lKeyName: string;
|
|
begin
|
|
lName := aName.ToLower;
|
|
lKeyName := GetKeyName(lName);
|
|
|
|
fMREW.BeginWrite;
|
|
try
|
|
if not fConnectionsDict.ContainsKey(lKeyName) then
|
|
raise Exception.CreateFmt('Unknown connection %s', [aName]);
|
|
fCurrentConnectionsByThread.AddOrSetValue(TThread.CurrentThread.ThreadID, lName);
|
|
finally
|
|
fMREW.EndWrite;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCConnectionsRepository.SetDefault;
|
|
begin
|
|
SetCurrent('default');
|
|
end;
|
|
|
|
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
|
|
begin
|
|
if gEntitiesRegistry = nil then
|
|
begin
|
|
TMonitor.Enter(gLock);
|
|
try
|
|
if gEntitiesRegistry = nil then
|
|
begin
|
|
gEntitiesRegistry := TMVCEntitiesRegistry.Create;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(gLock);
|
|
end;
|
|
end;
|
|
Result := gEntitiesRegistry;
|
|
end;
|
|
|
|
{ TableFieldAttribute }
|
|
|
|
constructor MVCTableFieldAttribute.Create(aFieldName: string; const aDataTypeName: string = '');
|
|
begin
|
|
Create(aFieldName, [], '', aDataTypeName);
|
|
end;
|
|
|
|
{ TableAttribute }
|
|
|
|
constructor MVCTableAttribute.Create(aName: string);
|
|
begin
|
|
Create(aName, '');
|
|
end;
|
|
|
|
{ TActiveRecord }
|
|
|
|
destructor TMVCActiveRecord.Destroy;
|
|
begin
|
|
fChildren.Free;
|
|
fSQLGenerator.Free;
|
|
fRQL2SQL.Free;
|
|
fConn := nil; // do not free it!!
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.EnsureConnection;
|
|
begin
|
|
GetConnection;
|
|
end;
|
|
|
|
function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
|
|
var
|
|
lQry: TFDQuery;
|
|
lPar: TFDParam;
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
lValue: TValue;
|
|
lSQL: string;
|
|
lHandled: Boolean;
|
|
I: Integer;
|
|
begin
|
|
{ TODO -oDanieleT -cGeneral : Why not a TFDCommand? }
|
|
lQry := TFDQuery.Create(nil);
|
|
try
|
|
lQry.Connection := GetConnection;
|
|
lSQL := SQL;
|
|
OnBeforeExecuteSQL(lSQL);
|
|
lQry.SQL.Text := lSQL;
|
|
|
|
lHandled := false;
|
|
// lQry.Prepare;
|
|
MapObjectToParams(lQry.Params, lHandled);
|
|
if not lHandled then
|
|
begin
|
|
{ partitioning }
|
|
for I := 0 to GetPartitionInfo.FieldNames.Count - 1 do
|
|
begin
|
|
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(GetPartitionInfo.FieldNames[I]));
|
|
if lPar <> nil then
|
|
begin
|
|
if GetPartitionInfo.FieldTypes[I] = ftInteger then
|
|
lValue := StrToInt(GetPartitionInfo.FieldValues[I])
|
|
else
|
|
lValue := GetPartitionInfo.FieldValues[I];
|
|
MapTValueToParam(lValue, lPar);
|
|
end
|
|
end;
|
|
{ end-partitioning }
|
|
|
|
for lPair in fTableMap.fMap do
|
|
begin
|
|
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
|
|
if (lPar <> nil) and (lpair.Value.Insertable or lpair.Value.Updatable) then
|
|
begin
|
|
lValue := lPair.Key.GetValue(Self);
|
|
lPar.DataTypeName := fTableMap.fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
|
|
MapTValueToParam(lValue, lPar);
|
|
end
|
|
end;
|
|
|
|
// Check if it's the primary key
|
|
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(fTableMap.fPrimaryKeyFieldName));
|
|
if lPar <> nil then
|
|
begin
|
|
if lPar.DataType = ftUnknown then
|
|
begin
|
|
{ TODO -oDanieleT -cGeneral : Let's find a smarter way to do this if the engine cannot recognize parameter's datatype }
|
|
lPar.DataType := GetPrimaryKeyFieldType;
|
|
end;
|
|
MapTValueToParam(fTableMap.fPrimaryKey.GetValue(Self), lPar);
|
|
end;
|
|
end;
|
|
|
|
if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fTableMap.fPrimaryKeyOptions) and
|
|
fTableMap.fPrimaryKeySequenceName.IsEmpty then
|
|
begin
|
|
lValue := fTableMap.fPrimaryKey.GetValue(Self);
|
|
lQry.Open;
|
|
|
|
if (lValue.Kind = tkRecord) then
|
|
begin
|
|
MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fTableMap.fPrimaryKey, Self);
|
|
end
|
|
else
|
|
begin
|
|
lValue := lQry.FieldByName(fTableMap.fPrimaryKeyFieldName).AsInteger;
|
|
fTableMap.fPrimaryKey.SetValue(Self, lValue);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
lQry.ExecSQL(lSQL);
|
|
end;
|
|
Result := lQry.RowsAffected;
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
|
|
const Connection: TFDConnection; const Unidirectional: Boolean;
|
|
const DirectExecute: Boolean): TDataSet;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, [], Connection, Unidirectional, DirectExecute);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.FillPrimaryKey(const SequenceName: string);
|
|
var
|
|
lDS: TDataSet;
|
|
lSQL: string;
|
|
begin
|
|
if not SequenceName.IsEmpty then
|
|
begin
|
|
lSQL := SQLGenerator.GetSequenceValueSQL(fTableMap.fPrimaryKeyFieldName, SequenceName);
|
|
if lSQL.IsEmpty then
|
|
begin
|
|
Exit;
|
|
end;
|
|
lDS := ExecQuery(lSQL, [], True, False);
|
|
try
|
|
MapDataSetFieldToRTTIField(lDS.Fields[0], fTableMap.fPrimaryKey, Self);
|
|
finally
|
|
lDS.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.FindRQLQueryByName(const QueryName: String;
|
|
out NamedRQLQuery: TRQLQueryWithName): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Low(fTableMap.fNamedRQLQueries) to High(fTableMap.fNamedRQLQueries) do
|
|
begin
|
|
if SameText(QueryName, fTableMap.fNamedRQLQueries[I].Name) then
|
|
begin
|
|
NamedRQLQuery := fTableMap.fNamedRQLQueries[I];
|
|
Exit(True);
|
|
end;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function TMVCActiveRecord.FindSQLQueryByName(const QueryName: String;
|
|
out NamedSQLQuery: TSQLQueryWithName): Boolean;
|
|
var
|
|
I: Integer;
|
|
lBackEnd: String;
|
|
begin
|
|
for I := Low(fTableMap.fNamedSQLQueries) to High(fTableMap.fNamedSQLQueries) do
|
|
begin
|
|
if SameText(QueryName, fTableMap.fNamedSQLQueries[I].Name) then
|
|
begin
|
|
lBackEnd := fTableMap.fNamedSQLQueries[I].BackEnd;
|
|
if lBackEnd.IsEmpty or (lBackEnd = GetBackEnd) then
|
|
begin
|
|
NamedSQLQuery := fTableMap.fNamedSQLQueries[I];
|
|
Exit(True);
|
|
end;
|
|
end;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
|
|
const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, nil, Unidirectional, DirectExecute);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.InitTableInfo(const aTableName: String);
|
|
var
|
|
lAttribute: TCustomAttribute;
|
|
lRTTIField: TRTTIField;
|
|
lFieldInfo: TFieldInfo;
|
|
lPrimaryFieldTypeAsStr: string;
|
|
lTableMap: TMVCTableMap;
|
|
lPKCount: Integer;
|
|
lNamedSQLQueryCount: Integer;
|
|
lNamedRQLQueryCount: Integer;
|
|
lNeedsTableName: Boolean;
|
|
begin
|
|
if ActiveRecordTableMapRegistry.TryGetValue(Self, aTableName, fTableMap) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
TMonitor.Enter(gTableMapLock);
|
|
try
|
|
if ActiveRecordTableMapRegistry.TryGetValue(Self, aTableName, fTableMap) then //double check here
|
|
begin
|
|
Exit;
|
|
end;
|
|
lTableMap := TMVCTableMap.Create;
|
|
SetLength(lTableMap.fMapping, 0);
|
|
lTableMap.fPartitionInfoInternal := nil;
|
|
lTableMap.fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve, TMVCEntityAction.eaUpdate,
|
|
TMVCEntityAction.eaDelete];
|
|
lTableMap.fTableName := aTableName;
|
|
lTableMap.fPartitionClause := '';
|
|
lTableMap.fRTTIType := gCtx.GetType(Self.ClassInfo) as TRttiInstanceType;
|
|
lTableMap.fObjAttributes := lTableMap.fRTTIType.GetAttributes;
|
|
lPKCount := 0;
|
|
lNeedsTableName := lTableMap.fTableName.IsEmpty;
|
|
lNamedSQLQueryCount := Length(lTableMap.fNamedSQLQueries);
|
|
lNamedRQLQueryCount := Length(lTableMap.fNamedRQLQueries);
|
|
for lAttribute in lTableMap.fObjAttributes do
|
|
begin
|
|
if lNeedsTableName and (lAttribute is MVCTableAttribute) then
|
|
begin
|
|
lTableMap.fTableName := MVCTableAttribute(lAttribute).Name;
|
|
lTableMap.fDefaultRQLFilter := MVCTableAttribute(lAttribute).RQLFilter;
|
|
Continue;
|
|
end;
|
|
if lAttribute is MVCEntityActionsAttribute then
|
|
begin
|
|
lTableMap.fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions;
|
|
Continue;
|
|
end;
|
|
if lAttribute is MVCPartitionAttribute then
|
|
begin
|
|
lTableMap.fPartitionClause := MVCPartitionAttribute(lAttribute).PartitionClause;
|
|
Continue;
|
|
end;
|
|
if lAttribute is MVCNamedSQLQueryAttribute then
|
|
begin
|
|
Inc(lNamedSQLQueryCount);
|
|
SetLength(lTableMap.fNamedSQLQueries, lNamedSQLQueryCount);
|
|
lTableMap.fNamedSQLQueries[lNamedSQLQueryCount - 1].Name := MVCNamedSQLQueryAttribute(lAttribute).Name;
|
|
lTableMap.fNamedSQLQueries[lNamedSQLQueryCount - 1].SQLText := MVCNamedSQLQueryAttribute(lAttribute).SQLQuery;
|
|
lTableMap.fNamedSQLQueries[lNamedSQLQueryCount - 1].BackEnd := MVCNamedSQLQueryAttribute(lAttribute).Backend;
|
|
Continue;
|
|
end;
|
|
if lAttribute is MVCNamedRQLQueryAttribute then
|
|
begin
|
|
Inc(lNamedRQLQueryCount);
|
|
SetLength(lTableMap.fNamedRQLQueries, lNamedRQLQueryCount);
|
|
lTableMap.fNamedRQLQueries[lNamedRQLQueryCount - 1].Name := MVCNamedRQLQueryAttribute(lAttribute).Name;
|
|
lTableMap.fNamedRQLQueries[lNamedRQLQueryCount - 1].RQLText := MVCNamedRQLQueryAttribute(lAttribute).RQLQuery;
|
|
Continue;
|
|
end;
|
|
end;
|
|
|
|
if lTableMap.fTableName = '' then
|
|
begin
|
|
if [eaCreate, eaUpdate, eaDelete] * lTableMap.fEntityAllowedActions <> [] then
|
|
begin
|
|
raise Exception.Create('Cannot find MVCTable attribute nor a valid "GetCustomTableName" method on class "' + ClassName + '" - [HINT] Is ' + ClassName + ' class decorated with MVCTable and its fields with MVCTableField?');
|
|
end;
|
|
end;
|
|
|
|
lTableMap.fProps := lTableMap.fRTTIType.GetFields;
|
|
for lRTTIField in lTableMap.fProps do
|
|
begin
|
|
lTableMap.fPropsAttributes := lRTTIField.GetAttributes;
|
|
if Length(lTableMap.fPropsAttributes) = 0 then
|
|
Continue;
|
|
for lAttribute in lTableMap.fPropsAttributes do
|
|
begin
|
|
if lAttribute is MVCTableFieldAttribute then
|
|
begin
|
|
if foPrimaryKey in MVCTableFieldAttribute(lAttribute).FieldOptions then
|
|
begin
|
|
lTableMap.fPrimaryKeyInInsert := not (foAutoGenerated in MVCTableFieldAttribute(lAttribute).FieldOptions);
|
|
lTableMap.fPrimaryKey := lRTTIField;
|
|
lPrimaryFieldTypeAsStr := lTableMap.fPrimaryKey.FieldType.ToString.ToLowerInvariant;
|
|
if lPrimaryFieldTypeAsStr.EndsWith('int64') then
|
|
begin
|
|
lTableMap.fPrimaryKeyFieldType := ftLargeInt;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('integer')
|
|
or lPrimaryFieldTypeAsStr.EndsWith('int16')
|
|
or lPrimaryFieldTypeAsStr.EndsWith('int32') then
|
|
begin
|
|
lTableMap.fPrimaryKeyFieldType := ftInteger;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('string') then
|
|
begin
|
|
lTableMap.fPrimaryKeyFieldType := ftString;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('guid') then
|
|
begin
|
|
lTableMap.fPrimaryKeyFieldType := ftGuid;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create
|
|
('Allowed primary key types are: (Nullable)Integer, (Nullable)Int16, (Nullable)Int32, (Nullable)Int64, (Nullable)String, GUID - found: ' +
|
|
lPrimaryFieldTypeAsStr);
|
|
end;
|
|
lTableMap.fPrimaryKeyFieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
lTableMap.fPrimaryKeyOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
|
|
lTableMap.fPrimaryKeySequenceName := MVCTableFieldAttribute(lAttribute).SequenceName;
|
|
Inc(lPKCount);
|
|
Continue;
|
|
end;
|
|
|
|
lFieldInfo := TFieldInfo.Create;
|
|
lTableMap.fMap.Add(lRTTIField, lFieldInfo);
|
|
lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
lFieldInfo.FieldOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
|
|
lFieldInfo.DataTypeName := MVCTableFieldAttribute(lAttribute).DataTypeName;
|
|
|
|
if foVersion in lFieldInfo.FieldOptions then
|
|
begin
|
|
if not lTableMap.fVersionFieldName.IsEmpty then
|
|
begin
|
|
raise EMVCActiveRecord.Create('Only one version field is allowed for table - Currently at least fields [' + lTableMap.fVersionFieldName + '] and [' + lFieldInfo.FieldName + '] are marked as foVersion');
|
|
end;
|
|
lTableMap.fVersionRTTIField := lRTTIField;
|
|
lTableMap.fVersionFieldName := lFieldInfo.FieldName;
|
|
lTableMap.fIsVersioned := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
lTableMap.fMap.EndUpdates;
|
|
|
|
if (lPKCount + lTableMap.fMap.WritableFieldsCount + lTableMap.fMap.ReadableFieldsCount) = 0 then
|
|
begin
|
|
raise EMVCActiveRecord.Create(
|
|
'No fields nor PKs defined in class ' + ClassName + '. [HINT] Use MVCTableField in private fields');
|
|
end;
|
|
|
|
if lTableMap.fIsVersioned then
|
|
begin
|
|
lFieldInfo := lTableMap.fMap.GetInfoByFieldName(lTableMap.fVersionFieldName);
|
|
if not (lFieldInfo.Insertable and lFieldInfo.Updatable) then
|
|
begin
|
|
raise EMVCActiveRecord
|
|
.CreateFmt('Field [%s], is marked as foVersion so must be a Read/Write field - ' +
|
|
'[HINT] This constraint is valid only for the field itself, a property mapped over this field can be defined "read-only", "write-only" or "read-write"',
|
|
[lTableMap.fVersionFieldName]);
|
|
end;
|
|
end;
|
|
|
|
lTableMap.fPartitionInfoInternal := nil;
|
|
ActiveRecordTableMapRegistry.AddTableMap(Self, aTableName, lTableMap);
|
|
fTableMap := lTableMap;
|
|
finally
|
|
TMonitor.Exit(gTableMapLock);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Insert;
|
|
var
|
|
SQL: string;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaCreate);
|
|
OnValidation(TMVCEntityAction.eaCreate);
|
|
OnBeforeInsert;
|
|
OnBeforeInsertOrUpdate;
|
|
if (fTableMap.fMap.WritableFieldsCount = 0) and (not fTableMap.fPrimaryKeyInInsert) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Cannot insert an entity if no fields are writable. Class [%s] mapped on table [%s]',
|
|
[ClassName, TableName]);
|
|
end;
|
|
if (not fTableMap.fPrimaryKeyInInsert) {autogenerated} then
|
|
begin
|
|
if not SQLGenerator.HasReturning then
|
|
begin
|
|
if not SQLGenerator.HasSequences then
|
|
begin
|
|
raise EMVCActiveRecord.Create
|
|
('Cannot use AutoGenerated primary keys if the engine doesn''t support returning clause nor sequences');
|
|
end
|
|
else
|
|
begin
|
|
if fTableMap.fPrimaryKeySequenceName.IsEmpty then
|
|
begin
|
|
raise EMVCActiveRecord.Create('SequenceName is empty for entity ' + ClassName + ' but ' + GetBackEnd +
|
|
' requires it');
|
|
end;
|
|
if foReadOnly in fTableMap.fPrimaryKeyOptions then
|
|
begin
|
|
raise EMVCActiveRecord.Create('Cannot define a read-only primary key when a sequence is used for the class ' +
|
|
ClassName);
|
|
end;
|
|
FillPrimaryKey(fTableMap.fPrimaryKeySequenceName);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
SQL := SQLGenerator.CreateInsertSQL(fTableMap, Self);
|
|
ExecNonQuery(SQL, True);
|
|
if fTableMap.fIsVersioned then
|
|
begin
|
|
{ in case of INSERT version is defined by constants }
|
|
SetInitialObjVersion(fTableMap, Self);
|
|
end;
|
|
OnAfterInsert;
|
|
OnAfterInsertOrUpdate;
|
|
end;
|
|
|
|
function TMVCActiveRecord.InternalCount(const RQL: string): int64;
|
|
var
|
|
lSQL: string;
|
|
begin
|
|
lSQL := Self.SQLGenerator.CreateSelectCount(TableName);
|
|
lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false, True);
|
|
Result := GetScalar(lSQL, []);
|
|
end;
|
|
|
|
function TMVCActiveRecord.InternalSelectRQL(const RQL: string;
|
|
const MaxRecordCount: Integer; const OutList: TMVCActiveRecordList): UInt32;
|
|
var
|
|
lSQL: string;
|
|
begin
|
|
lSQL := SQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, True, false, MaxRecordCount);
|
|
LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
|
|
Result := Where(TMVCActiveRecordClass(Self.ClassType), lSQL, [], nil, OutList);
|
|
end;
|
|
|
|
function TMVCActiveRecord.InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
|
|
var
|
|
lSQL: string;
|
|
begin
|
|
lSQL := SQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, True, false, MaxRecordCount);
|
|
LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
|
|
Result := Where(TMVCActiveRecordClass(Self.ClassType), lSQL, []);
|
|
end;
|
|
|
|
constructor TMVCActiveRecord.Create(aLazyLoadConnection: Boolean);
|
|
begin
|
|
inherited Create;
|
|
fConn := nil;
|
|
if not aLazyLoadConnection then
|
|
begin
|
|
GetConnection;
|
|
end;
|
|
InitTableInfo(GetCustomTableName);
|
|
end;
|
|
|
|
function TMVCActiveRecord.GenerateSelectSQL: string;
|
|
begin
|
|
Result := SQLGenerator.CreateSelectSQL(TableName, fTableMap.fMap,
|
|
fTableMap.fPrimaryKeyFieldName, fTableMap.fPrimaryKeyOptions);
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetAttributes(const AttrName: string): TValue;
|
|
var
|
|
lProperty: TRttiProperty;
|
|
begin
|
|
if not TRttiUtils.ExistsProperty(Self, AttrName, lProperty) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('Attribute [%s] not found', [AttrName]);
|
|
end;
|
|
Result := lProperty.GetValue(Self);
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetBackEnd: string;
|
|
begin
|
|
if fBackendDriver.IsEmpty then
|
|
begin
|
|
fBackendDriver := GetBackEndByConnection(GetConnection);
|
|
end;
|
|
Result := fBackendDriver;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.GetByPK(aActiveRecord: TMVCActiveRecord; const aValue: string;
|
|
const aFieldType: TFieldType; const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
|
|
var
|
|
lFound: Boolean;
|
|
begin
|
|
Result := aActiveRecord;
|
|
try
|
|
if Result.SQLGenerator.HasNativeUUID then
|
|
begin
|
|
lFound := Result.LoadByPK(aValue, aFieldType)
|
|
end
|
|
else
|
|
begin
|
|
lFound := Result.LoadByPK(aValue);
|
|
end;
|
|
if not lFound then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.CreateFmt('No data found for key [Entity: %s][PK: %s]',
|
|
[aActiveRecord.ClassName, aActiveRecord.fTableMap.fPrimaryKeyFieldName])
|
|
else
|
|
FreeAndNil(Result);
|
|
end;
|
|
except
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
|
|
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
|
|
begin
|
|
Result := GetByPK(aClass.Create, aValue, ftString, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
|
|
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
|
|
begin
|
|
Result := GetByPK(aClass.Create, aValue.ToString, ftInteger, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: TGuid;
|
|
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
|
|
begin
|
|
Result := GetByPK(aClass.Create, aValue.ToString, ftGuid, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: int64;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T;
|
|
begin
|
|
Result := GetByPK<T>(aValue.ToString, ftInteger, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string; const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := GetByPK<T>(aValue, ftString, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: TGuid; const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := GetByPK<T>(aValue.ToString, ftGuid, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string; const aFieldType: TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := T(GetByPK(T.Create, aValue, aFieldType, RaiseExceptionIfNotFound));
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
|
|
var
|
|
lList: TObjectList<T>;
|
|
begin
|
|
lList := Where<T>(SQLWhere, Params, ParamTypes);
|
|
try
|
|
if lList.Count = 0 then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when at least 1 was expected');
|
|
Exit(nil);
|
|
end;
|
|
Result := lList.Extract(lList.First);
|
|
finally
|
|
lList.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := GetFirstByWhere<T>(SQLWhere, Params, [], RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := GetFirstByWhere<T>(SQLWhere, Params, ParamTypes, false);
|
|
if Result = nil then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
I: Integer;
|
|
lPropFromField: TRttiProperty;
|
|
lParentType: TRttiType;
|
|
lTmp: String;
|
|
begin
|
|
{ TODO -oDanieleT -cGeneral : Let share the mapping for instances of the same type }
|
|
{ TODO -oDanieleT -cGeneral : Add NameAs in the TFieldInfo because the user needs to use the property name he see }
|
|
if Length(fTableMap.fMapping) = 0 then
|
|
begin
|
|
if not fTableMap.fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
lParentType := fTableMap.fPrimaryKey.Parent;
|
|
SetLength(fTableMap.fMapping, fTableMap.fMap.Count + 1);
|
|
fTableMap.fMapping[0].InstanceFieldName := fTableMap.fPrimaryKey.Name.Substring(1).ToLower;
|
|
fTableMap.fMapping[0].DatabaseFieldName := fTableMap.fPrimaryKeyFieldName;
|
|
lPropFromField := lParentType.GetProperty(fTableMap.fPrimaryKey.Name.Substring(1));
|
|
if Assigned(lPropFromField) then
|
|
begin
|
|
lTmp := TMVCSerializerHelper.GetKeyName(lPropFromField, lParentType);
|
|
if not SameText(lTmp, fTableMap.fMapping[0].InstanceFieldName) then
|
|
begin
|
|
fTableMap.fMapping[0].Alias := lTmp;
|
|
end;
|
|
end;
|
|
I := 1;
|
|
end
|
|
else
|
|
begin
|
|
SetLength(fTableMap.fMapping, fTableMap.fMap.Count);
|
|
I := 0;
|
|
end;
|
|
|
|
for lPair in fTableMap.fMap do
|
|
begin
|
|
lParentType := lPair.Key.Parent;
|
|
fTableMap.fMapping[I].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
|
|
fTableMap.fMapping[I].DatabaseFieldName := lPair.Value.FieldName;
|
|
|
|
lPropFromField := lParentType.GetProperty(lPair.Key.Name.Substring(1));
|
|
if Assigned(lPropFromField) then
|
|
begin
|
|
lTmp := TMVCSerializerHelper.GetKeyName(lPropFromField, lParentType);
|
|
if not SameText(lTmp, fTableMap.fMapping[I].InstanceFieldName) then
|
|
begin
|
|
fTableMap.fMapping[I].Alias := lTmp;
|
|
end;
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
Result := fTableMap.fMapping;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string; const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := GetFirstByWhere<T>(SQLWhere, Params, false);
|
|
if Result = nil then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectOneByRQL<T>(const RQL: string; const RaiseExceptionIfNotFound: Boolean): T;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
lSQL: string;
|
|
begin
|
|
lAR := T.Create;
|
|
try
|
|
lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping).Trim;
|
|
lSQL := TMVCSQLGenerator.RemoveInitialWhereKeyword(lSQL);
|
|
Result := GetFirstByWhere<T>(lSQL, [], RaiseExceptionIfNotFound);
|
|
if Result = nil then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
|
|
end;
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectRQL<T>(const RQL: string;
|
|
const MaxRecordCount: Integer; const OutList: TObjectList<T>): UInt32;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
lSQL: string;
|
|
begin
|
|
lAR := T.Create;
|
|
try
|
|
lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping, MaxRecordCount > -1, false, MaxRecordCount).Trim;
|
|
lSQL := TMVCSQLGenerator.RemoveInitialWhereKeyword(lSQL);
|
|
Result := Where<T>(lSQL, [], [], OutList);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectRQLByNamedQuery(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass; const QueryName: String;
|
|
const Params: array of const;
|
|
const MaxRecordCount: Integer): TMVCActiveRecordList;
|
|
var
|
|
lT: TMVCActiveRecord;
|
|
lRQLQuery: TRQLQueryWithName;
|
|
begin
|
|
lT := MVCActiveRecordClass.Create;
|
|
try
|
|
if not lT.FindRQLQueryByName(QueryName, lRQLQuery) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('NamedRQLQuery not found: %s', [QueryName]);
|
|
end;
|
|
Result := SelectRQL(MVCActiveRecordClass, Format(lRQLQuery.RQLText, Params), MaxRecordCount);
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectRQLByNamedQuery<T>(
|
|
const QueryName: string;
|
|
const Params: array of const;
|
|
const MaxRecordCount: Integer): TObjectList<T>;
|
|
var
|
|
lT: T;
|
|
lRQLQuery: TRQLQueryWithName;
|
|
begin
|
|
lT := T.Create;
|
|
try
|
|
if not lT.FindRQLQueryByName(QueryName, lRQLQuery) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('NamedRQLQuery not found: %s', [QueryName]);
|
|
end;
|
|
Result := SelectRQL<T>(Format(lRQLQuery.RQLText, Params), MaxRecordCount);
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string;
|
|
const Params: array of Variant; const ParamTypes: array of TFieldType;
|
|
const OutList: TObjectList<T>): UInt32;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
lFilter: string;
|
|
begin
|
|
lAR := T.Create;
|
|
try
|
|
lFilter := lAR.SQLGenerator.GetDefaultSQLFilter(True);
|
|
if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then
|
|
begin
|
|
Result := Select<T>(lAR.GenerateSelectSQL + lFilter + SQLWhere, Params, ParamTypes, [], OutList);
|
|
end
|
|
else
|
|
begin
|
|
if lFilter.IsEmpty then
|
|
begin
|
|
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes, [], OutList);
|
|
end
|
|
else
|
|
begin
|
|
Result := Select<T>(lAR.GenerateSelectSQL + lFilter + ' AND ' + SQLWhere, Params, ParamTypes, [], OutList);
|
|
end;
|
|
end;
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetPartitionInfo: TPartitionInfo;
|
|
var
|
|
lRQLCompilerClass: TRQLCompilerClass;
|
|
begin
|
|
if fTableMap.fPartitionInfoInternal = nil then
|
|
begin
|
|
lRQLCompilerClass := TRQLCompilerRegistry.Instance.GetCompiler(GetBackEnd);
|
|
fTableMap.fPartitionInfoInternal := TPartitionInfo.BuildPartitionClause(fTableMap.fPartitionClause, lRQLCompilerClass);
|
|
end;
|
|
Result := fTableMap.fPartitionInfoInternal;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetPK: TValue;
|
|
var
|
|
lIsNullableType: Boolean;
|
|
begin
|
|
if not TryGetPKValue(Result, lIsNullableType) then
|
|
begin
|
|
if not lIsNullableType then
|
|
begin
|
|
raise EMVCActiveRecord.Create('Primary key not available');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.PKIsNull: Boolean;
|
|
var
|
|
lValue: TValue;
|
|
lIsNullableType: Boolean;
|
|
begin
|
|
if not PKIsNullable(lValue) then
|
|
begin
|
|
raise EMVCActiveRecord.Create('PK is not nullable');
|
|
end;
|
|
Result := not TryGetPKValue(lValue, lIsNullableType);
|
|
end;
|
|
|
|
function TMVCActiveRecord.PKIsNullable(out PKValue: TValue): Boolean;
|
|
var
|
|
lValue: TValue;
|
|
begin
|
|
PKValue := TryGetPKValue(lValue, Result);
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetPrimaryKeyFieldType: TFieldType;
|
|
begin
|
|
Result := fTableMap.fPrimaryKeyFieldType;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetPrimaryKeyIsAutogenerated: Boolean;
|
|
begin
|
|
Result := foAutoGenerated in fTableMap.fPrimaryKeyOptions;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.GetScalar(const SQL: string; const Params: array of Variant): Variant;
|
|
begin
|
|
Result := CurrentConnection.ExecSQLScalar(SQL, Params);
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetTableName: string;
|
|
begin
|
|
if Assigned(fTableMap) then
|
|
begin
|
|
Result := fTableMap.fTableName
|
|
end
|
|
else
|
|
begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean): Boolean;
|
|
begin
|
|
Result := aEntityAction in fTableMap.fEntityAllowedActions;
|
|
if (not Result) and aRaiseException then
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Action [%s] not allowed on entity [%s]. [HINT] If this isn''t the expected behavior, add the entity action in MVCEntityActions attribute.',
|
|
[GetEnumName(TypeInfo(TMVCEntityAction), Ord(aEntityAction)), ClassName]) at ReturnAddress;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Count(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
// Up to 10.1 Berlin, here the compiler try to call the Count<T> introduced by the class helper
|
|
// Instead of the Count() which exists in "TMVCActiveRecord"
|
|
Result := lAR.InternalCount(RQL);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecordHelper.Count(const RQL: string = ''): int64;
|
|
begin
|
|
Result := InternalCount(RQL);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Count<T>(const RQL: string = ''): int64;
|
|
begin
|
|
Result := TMVCActiveRecord.Count(TMVCActiveRecordClass(T), RQL);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.CountRQLByNamedQuery<T>(
|
|
const QueryName: string;
|
|
const Params: array of const): Int64;
|
|
var
|
|
lRQLQuery: TRQLQueryWithName;
|
|
lT: T;
|
|
begin
|
|
lT := T.Create;
|
|
try
|
|
if not lT.FindRQLQueryByName(QueryName, lRQLQuery) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('NamedRQLQuery not found: %s', [QueryName]);
|
|
end;
|
|
Result := Count<T>(Format(lRQLQuery.RQLText, Params));
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.CreateMVCActiveRecord<T>(
|
|
AQualifiedClassName: string; const AParams: TArray<TValue>): T;
|
|
var
|
|
lTmp: TObject;
|
|
begin
|
|
lTmp := TRttiUtils.CreateObject(AQualifiedClassName, AParams);
|
|
try
|
|
Result := lTmp as T;
|
|
except
|
|
on E: EInvalidCast do
|
|
begin
|
|
lTmp.Free;
|
|
raise EMVCActiveRecord.Create(AQualifiedClassName + ' is not a TMVCActiveRecord descendant');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.DeleteRQL<T>(const RQL: string): int64;
|
|
begin
|
|
Result := TMVCActiveRecord.DeleteRQL(TMVCActiveRecordClass(T), RQL);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.DeleteRQLByNamedQuery<T>(
|
|
const QueryName: String;
|
|
const Params: array of const): Int64;
|
|
var
|
|
lRQLQuery: TRQLQueryWithName;
|
|
lT: T;
|
|
begin
|
|
lT := T.Create;
|
|
try
|
|
if not lT.FindRQLQueryByName(QueryName, lRQLQuery) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('NamedRQLQuery not found: %s', [QueryName]);
|
|
end;
|
|
Result := DeleteRQL<T>(Format(lRQLQuery.RQLText, Params));
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.TryGetSQLQuery<T>(
|
|
const QueryName: String; out NamedSQLQuery: TSQLQueryWithName): Boolean;
|
|
var
|
|
lT: T;
|
|
begin
|
|
lT := T.Create;
|
|
try
|
|
Result := lT.FindSQLQueryByName(QueryName, NamedSQLQuery);
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
{$IF Defined(CUSTOM_MANAGED_RECORDS)}
|
|
class function TMVCActiveRecordHelper.UseTransactionContext: TMVCTransactionContext;
|
|
begin
|
|
Result := TMVCTransactionContext.Create(0);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
class function TMVCActiveRecordHelper.TryGetRQLQuery<T>(
|
|
const QueryName: String; out NamedRQLQuery: TRQLQueryWithName): Boolean;
|
|
var
|
|
lT: T;
|
|
begin
|
|
lT := T.Create;
|
|
try
|
|
Result := lT.FindRQLQueryByName(QueryName, NamedRQLQuery);
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.CurrentConnection: TFDConnection;
|
|
begin
|
|
Result := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetConnection: TFDConnection;
|
|
begin
|
|
if fConn = nil then
|
|
begin
|
|
fConn := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
end;
|
|
Result := fConn;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetCustomTableName: String;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Delete(const RaiseExceptionIfNotFound: Boolean);
|
|
var
|
|
SQL: string;
|
|
lAffectedRows: int64;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaDelete);
|
|
OnValidation(TMVCEntityAction.eaDelete);
|
|
OnBeforeDelete;
|
|
if not Assigned(fTableMap.fPrimaryKey) then
|
|
raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
|
|
SQL := SQLGenerator.CreateDeleteSQL(fTableMap, Self);
|
|
lAffectedRows := ExecNonQuery(SQL, false);
|
|
if (lAffectedRows = 0) and RaiseExceptionIfNotFound then
|
|
begin
|
|
if fTableMap.fIsVersioned then
|
|
begin
|
|
raise EMVCActiveRecordVersionedItemNotFound.CreateFmt('No record deleted for key [Entity: %s][PK: %s][Version: %d] - record or version not found',
|
|
[ClassName, fTableMap.fPrimaryKeyFieldName, fTableMap.VersionValueAsInt64For(Self)]);
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecordNotFound.CreateFmt('No record deleted for key [Entity: %s][PK: %s]',
|
|
[ClassName, fTableMap.fPrimaryKeyFieldName]);
|
|
end;
|
|
end;
|
|
OnAfterDelete;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.DeleteAll(const aClass: TMVCActiveRecordClass): int64;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableMap.fTableName) +
|
|
lAR.SQLGenerator.GetDefaultSQLFilter(True));
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create(True);
|
|
try
|
|
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableMap.fTableName) +
|
|
lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping, false));
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
|
|
var Handled: Boolean);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.MapObjectToParams(const Params: TFDParams; var Handled: Boolean);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
|
|
var
|
|
lNullableType: TNullableType;
|
|
begin
|
|
Assert(aValue.Kind = tkRecord);
|
|
Result := True;
|
|
lNullableType := GetNullableType(aValue.TypeInfo);
|
|
case lNullableType of
|
|
ntInvalidNullableType:
|
|
begin
|
|
Exit(False);
|
|
end;
|
|
ntNullableString:
|
|
begin
|
|
if not aValue.AsType<NullableString>().HasValue then
|
|
begin
|
|
aParam.DataType := ftString;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableString>().Value;
|
|
end;
|
|
end;
|
|
ntNullableCurrency:
|
|
begin
|
|
if not aValue.AsType<NullableCurrency>().HasValue then
|
|
begin
|
|
aParam.DataType := TFieldType.ftCurrency;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableCurrency>().Value;
|
|
end;
|
|
end;
|
|
ntNullableBoolean:
|
|
begin
|
|
if not aValue.AsType<NullableBoolean>().HasValue then
|
|
begin
|
|
aParam.DataType := ftBoolean;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<Boolean>(aValue.AsType<NullableBoolean>().Value);
|
|
end;
|
|
end;
|
|
ntNullableTDate:
|
|
begin
|
|
if not aValue.AsType<NullableTDate>().HasValue then
|
|
begin
|
|
aParam.DataType := ftDate;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TDate>(aValue.AsType<NullableTDate>().Value);
|
|
end;
|
|
end;
|
|
ntNullableTTime:
|
|
begin
|
|
if not aValue.AsType<NullableTTime>().HasValue then
|
|
begin
|
|
aParam.DataType := ftTime;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TTime>(aValue.AsType<NullableTTime>().Value);
|
|
end;
|
|
end;
|
|
ntNullableTDateTime:
|
|
begin
|
|
if not aValue.AsType<NullableTDateTime>().HasValue then
|
|
begin
|
|
aParam.DataType := ftDateTime;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TDateTime>(aValue.AsType<NullableTDateTime>().Value);
|
|
end;
|
|
end;
|
|
ntNullableSingle:
|
|
begin
|
|
if not aValue.AsType<NullableSingle>().HasValue then
|
|
begin
|
|
aParam.DataType := TFieldType.ftSingle;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableSingle>().Value;
|
|
end;
|
|
end;
|
|
ntNullableDouble:
|
|
begin
|
|
if not aValue.AsType<NullableDouble>().HasValue then
|
|
begin
|
|
aParam.DataType := TFieldType.ftFloat;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableDouble>().Value;
|
|
end;
|
|
end;
|
|
ntNullableExtended:
|
|
begin
|
|
if not aValue.AsType<NullableExtended>().HasValue then
|
|
begin
|
|
aParam.DataType := TFieldType.ftExtended;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableExtended>().Value;
|
|
end;
|
|
end;
|
|
ntNullableInt16:
|
|
begin
|
|
if not aValue.AsType<NullableInt16>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableInt16>().Value;
|
|
end;
|
|
end;
|
|
ntNullableUInt16:
|
|
begin
|
|
if not aValue.AsType<NullableUInt16>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableUInt16>().Value;
|
|
end;
|
|
end;
|
|
ntNullableInt32:
|
|
begin
|
|
if not aValue.AsType<NullableInt32>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableInt32>().Value;
|
|
end;
|
|
end;
|
|
ntNullableUInt32:
|
|
begin
|
|
if not aValue.AsType<NullableUInt32>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableUInt32>().Value;
|
|
end;
|
|
end;
|
|
ntNullableInt64:
|
|
begin
|
|
if not aValue.AsType<NullableInt64>().HasValue then
|
|
begin
|
|
aParam.DataType := ftLargeInt;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableInt64>().Value;
|
|
end;
|
|
end;
|
|
ntNullableUInt64:
|
|
begin
|
|
if not aValue.AsType<NullableUInt64>().HasValue then
|
|
begin
|
|
aParam.DataType := ftLargeInt;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableUInt64>().Value;
|
|
end;
|
|
end;
|
|
ntNullableTGUID:
|
|
begin
|
|
if not aValue.AsType<NullableTGUID>().HasValue then
|
|
begin
|
|
aParam.DataType := TFieldType.ftGuid;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TGuid>(aValue.AsType<NullableTGUID>().Value);
|
|
end;
|
|
end;
|
|
end; // case
|
|
|
|
// the nullable value contains a value, so let's call
|
|
// the "non nullable" version of this procedure
|
|
MapTValueToParam(aValue, aParam);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam);
|
|
const
|
|
MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value }
|
|
var
|
|
lStream: TStream;
|
|
lName: string;
|
|
begin
|
|
{$IFDEF NEXTGEN}
|
|
lName := aValue.TypeInfo.NameFld.ToString;
|
|
{$ELSE}
|
|
lName := string(aValue.TypeInfo.Name);
|
|
{$ENDIF}
|
|
if (lName.StartsWith('Nullable', True) and (aValue.TypeInfo.Kind = tkRecord)) then
|
|
begin
|
|
if MapNullableTValueToParam(aValue, aParam) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
case aValue.TypeInfo.Kind of
|
|
tkUString:
|
|
begin
|
|
case aParam.DataType of
|
|
ftUnknown, ftWideString:
|
|
begin
|
|
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
|
|
begin
|
|
aParam.AsWideMemo := aValue.AsString;
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsWideString := aValue.AsString;
|
|
end;
|
|
end;
|
|
ftString:
|
|
begin
|
|
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
|
|
begin
|
|
aParam.AsMemo := AnsiString(aValue.AsString);
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsString := aValue.AsString;
|
|
end;
|
|
end;
|
|
ftWideMemo:
|
|
begin
|
|
aParam.AsWideMemo := aValue.AsString;
|
|
end;
|
|
ftMemo:
|
|
begin
|
|
aParam.AsMemo := AnsiString(aValue.AsString);
|
|
end;
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('Invalid parameter type for (tkUString) [%s]', [lName]);
|
|
end;
|
|
end;
|
|
end;
|
|
tkString:
|
|
begin
|
|
case aParam.DataType of
|
|
ftUnknown, ftWideString:
|
|
begin
|
|
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
|
|
begin
|
|
aParam.AsWideMemo := aValue.AsString;
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsWideString := aValue.AsString;
|
|
end;
|
|
end;
|
|
ftString:
|
|
begin
|
|
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
|
|
begin
|
|
aParam.AsMemo := AnsiString(aValue.AsString);
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsString := aValue.AsString;
|
|
end;
|
|
end;
|
|
ftWideMemo:
|
|
begin
|
|
aParam.AsWideMemo := aValue.AsString;
|
|
end;
|
|
ftMemo:
|
|
begin
|
|
aParam.AsMemo := AnsiString(aValue.AsString);
|
|
end;
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('Invalid parameter type for (tkString) [%s]', [lName]);
|
|
end;
|
|
end;
|
|
end;
|
|
{$IF Defined(SeattleOrBetter)}
|
|
tkWideString:
|
|
begin
|
|
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
|
|
begin
|
|
aParam.AsWideMemo := aValue.AsString;
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsWideString := aValue.AsString;
|
|
end
|
|
end;
|
|
{$ENDIF}
|
|
tkInt64:
|
|
begin
|
|
aParam.AsLargeInt := aValue.AsInt64;
|
|
end;
|
|
tkInteger:
|
|
begin
|
|
aParam.AsInteger := aValue.AsInteger;
|
|
end;
|
|
tkEnumeration:
|
|
begin
|
|
if aValue.TypeInfo = TypeInfo(System.Boolean) then
|
|
begin
|
|
if aParam.DataTypeName.StartsWith('int', true) then
|
|
begin
|
|
aParam.AsInteger := IfThen(aValue.AsBoolean,1,0);
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsBoolean := aValue.AsBoolean;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsInteger := aValue.AsOrdinal;
|
|
end;
|
|
end;
|
|
tkFloat:
|
|
begin
|
|
if lName = 'TDate' then
|
|
begin
|
|
aParam.AsDate := Trunc(aValue.AsExtended);
|
|
end
|
|
else if lName = 'TDateTime' then
|
|
begin
|
|
aParam.AsDateTime := aValue.AsExtended;
|
|
end
|
|
else if lName = 'TTime' then
|
|
begin
|
|
aParam.AsTime := aValue.AsExtended;
|
|
end
|
|
else if lName = 'Currency' then
|
|
begin
|
|
aParam.AsCurrency := aValue.AsCurrency;
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsFloat := aValue.AsExtended;
|
|
end;
|
|
end;
|
|
tkClass:
|
|
begin
|
|
if (aValue.AsObject <> nil) and (not aValue.IsInstanceOf(TStream)) then
|
|
raise EMVCActiveRecord.CreateFmt('Unsupported reference type for param %s: %s',
|
|
[aParam.Name, aValue.AsObject.ClassName]);
|
|
{ .$IF Defined(SeattleOrBetter) }
|
|
// lStream := aValue.AsType<TStream>();
|
|
{ .$ELSE }
|
|
lStream := aValue.AsType<TStream>();
|
|
{ .$ENDIF }
|
|
if Assigned(lStream) then
|
|
begin
|
|
lStream.Position := 0;
|
|
aParam.LoadFromStream(lStream, ftBlob);
|
|
end
|
|
else
|
|
begin
|
|
aParam.DataType := TFieldType.ftBlob;
|
|
aParam.Clear;
|
|
end;
|
|
end;
|
|
tkRecord:
|
|
begin
|
|
if aValue.TypeInfo = TypeInfo(TGuid) then
|
|
begin
|
|
if SQLGenerator.HasNativeUUID then
|
|
begin
|
|
aParam.AsGuid := aValue.AsType<TGuid>
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsString := GUIDToString(aValue.AsType<TGuid>);
|
|
end;
|
|
end
|
|
else if aValue.TypeInfo = TypeInfo(NullableTGUID) then
|
|
begin
|
|
if aValue.AsType<NullableTGUID>.HasValue then
|
|
aParam.AsGuid := aValue.AsType<NullableTGUID>.Value
|
|
else
|
|
aParam.Clear();
|
|
end
|
|
else
|
|
begin
|
|
raise Exception.CreateFmt('Unsupported Record TypeKind (%d) for param %s',
|
|
[Ord(aValue.TypeInfo.Kind), aParam.Name]);
|
|
end;
|
|
end;
|
|
else
|
|
raise Exception.CreateFmt('Unsupported TypeKind (%d) for param %s', [Ord(aValue.TypeInfo.Kind), aParam.Name]);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.LoadByDataset(const aDataSet: TDataSet; const aOptions: TMVCActiveRecordLoadOptions);
|
|
var
|
|
lItem: TPair<TRTTIField, TFieldInfo>;
|
|
lField: TField;
|
|
lHandled: Boolean;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaRetrieve);
|
|
OnBeforeLoad;
|
|
|
|
lHandled := false;
|
|
MapDatasetToObject(aDataSet, aOptions, lHandled);
|
|
if not lHandled then
|
|
begin
|
|
for lItem in fTableMap.fMap do
|
|
begin
|
|
if not lItem.Value.Selectable then
|
|
begin
|
|
Continue;
|
|
end;
|
|
lField := aDataSet.FindField(lItem.Value.FieldName);
|
|
if lField = nil then
|
|
begin
|
|
if TMVCActiveRecordLoadOption.loIgnoreNotExistentFields in aOptions then
|
|
Continue
|
|
else
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields',
|
|
[lItem.Value.FieldName]);
|
|
end;
|
|
MapDataSetFieldToRTTIField(lField, lItem.Key, Self);
|
|
end;
|
|
if not fTableMap.fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
MapDataSetFieldToRTTIField(aDataSet.FieldByName(fTableMap.fPrimaryKeyFieldName), fTableMap.fPrimaryKey, Self);
|
|
end;
|
|
end;
|
|
OnAfterLoad;
|
|
end;
|
|
|
|
function TMVCActiveRecord.LoadByPK(const id: string; const aFieldType: TFieldType): Boolean;
|
|
var
|
|
SQL: string;
|
|
lDataSet: TDataSet;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaRetrieve);
|
|
SQL := SQLGenerator.CreateSelectByPKSQL(TableName, fTableMap.fMap,
|
|
fTableMap.fPrimaryKeyFieldName, fTableMap.fPrimaryKeyOptions);
|
|
lDataSet := ExecQuery(SQL, [id], [aFieldType], GetConnection, True, False);
|
|
try
|
|
Result := not lDataSet.Eof;
|
|
if Result then
|
|
begin
|
|
LoadByDataset(lDataSet);
|
|
end;
|
|
finally
|
|
lDataSet.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.LoadByPK(const id: string): Boolean;
|
|
begin
|
|
Result := LoadByPK(id, ftString);
|
|
end;
|
|
|
|
function TMVCActiveRecord.LoadByPK(const id: int64): Boolean;
|
|
begin
|
|
Result := LoadByPK(id.ToString, ftInteger);
|
|
end;
|
|
|
|
function TMVCActiveRecord.LoadByPK(const id: TGuid): Boolean;
|
|
begin
|
|
Result := LoadByPK(id.ToString, ftGuid);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnAfterDelete;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnAfterInsert;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnAfterInsertOrUpdate;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnAfterLoad;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnAfterUpdate;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnBeforeDelete;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnBeforeExecuteSQL(var SQL: string);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnBeforeInsert;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnBeforeInsertOrUpdate;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnBeforeLoad;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnBeforeUpdate;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.OnValidation(const EntityAction: TMVCEntityAction);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Refresh;
|
|
begin
|
|
if not GetPK.IsEmpty then
|
|
begin
|
|
case GetPrimaryKeyFieldType of
|
|
ftLargeInt: begin
|
|
LoadByPK(GetPK.AsInt64);
|
|
end;
|
|
ftInteger: begin
|
|
LoadByPK(GetPK.AsInteger);
|
|
end;
|
|
ftString: begin
|
|
LoadByPK(GetPK.AsString);
|
|
end;
|
|
ftGuid: begin
|
|
LoadByPK(GetPK.AsType<TGUID>);
|
|
end;
|
|
else
|
|
raise EMVCActiveRecord.Create('Unknown primary key type');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.RemoveChildren(const ChildObject: TObject);
|
|
begin
|
|
if fChildren <> nil then
|
|
begin
|
|
fChildren.Extract(ChildObject);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
|
|
begin
|
|
FreeAndNil(fConn);
|
|
if ReacquireAfterInvalidate then
|
|
begin
|
|
EnsureConnection;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant): TMVCActiveRecordList;
|
|
begin
|
|
Result := Select(aClass, SQL, Params, nil);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
|
|
begin
|
|
Result := TMVCActiveRecordList.Create;
|
|
try
|
|
Select(aClass, SQL, Params, Connection, Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
|
|
begin
|
|
Result := TMVCActiveRecord.ExecQuery(SQL, Params, ParamTypes, Unidirectional, DirectExecute);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
|
|
const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
|
|
begin
|
|
Result := Select<T>(SQL, Params, [], Options);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
|
|
begin
|
|
Result := TMVCActiveRecord.ExecQuery(SQL, Params, Unidirectional, DirectExecute);
|
|
end;
|
|
|
|
function TMVCActiveRecordHelper.SelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
|
|
begin
|
|
Result := InternalSelectRQL(RQL, MaxRecordCount);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectRQL(const aClass: TMVCActiveRecordClass;
|
|
const RQL: string; const MaxRecordCount: Integer;
|
|
const OutList: TMVCActiveRecordList): UInt32;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create(True);
|
|
try
|
|
Result := lAR.InternalSelectRQL(RQL, MaxRecordCount, OutList);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant; const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions;
|
|
const OutList: TMVCActiveRecordList): UInt32;
|
|
var
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lDataSet := ExecQuery(SQL, Params, ParamTypes, True, False);
|
|
try
|
|
while not lDataSet.Eof do
|
|
begin
|
|
lAR := MVCActiveRecordClass.Create;
|
|
OutList.Add(lAR);
|
|
lAR.LoadByDataset(lDataSet, Options);
|
|
lDataSet.Next;
|
|
end;
|
|
Result := OutList.Count;
|
|
finally
|
|
lDataSet.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant; const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions): TMVCActiveRecordList;
|
|
begin
|
|
Result := TMVCActiveRecordList.Create;
|
|
try
|
|
Select(MVCActiveRecordClass, SQL, Params, ParamTypes, Options, Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions; const OutList: TObjectList<T>): UInt32;
|
|
var
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lDataSet := ExecQuery(SQL, Params, ParamTypes, True, False);
|
|
try
|
|
while not lDataSet.Eof do
|
|
begin
|
|
lAR := T.Create;
|
|
OutList.Add(lAR);
|
|
lAR.LoadByDataset(lDataSet, Options);
|
|
lDataSet.Next;
|
|
end;
|
|
Result := OutList.Count;
|
|
finally
|
|
lDataSet.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectByNamedQuery(
|
|
const MVCActiveRecordClass: TMVCActiveRecordClass; const QueryName: String;
|
|
const Params: array of Variant; const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions): TMVCActiveRecordList;
|
|
var
|
|
lT: TMVCActiveRecord;
|
|
lSQLQuery: TSQLQueryWithName;
|
|
begin
|
|
lT := MVCActiveRecordClass.Create;
|
|
try
|
|
if not lT.FindSQLQueryByName(QueryName, lSQLQuery) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('NamedSQLQuery "%s" not found for entity "%s"', [QueryName, lT.ClassName]);
|
|
end;
|
|
Result := Select(MVCActiveRecordClass, lSQLQuery.SQLText, Params, ParamTypes, Options);
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectByNamedQuery<T>(
|
|
const QueryName: String; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
|
|
var
|
|
lT: T;
|
|
lSQLQuery: TSQLQueryWithName;
|
|
begin
|
|
lT := T.Create;
|
|
try
|
|
if not lT.FindSQLQueryByName(QueryName, lSQLQuery) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('NamedSQLQuery "%s" not found for entity "%s"', [QueryName, lT.ClassName]);
|
|
end;
|
|
Result := Select<T>(lSQLQuery.SQLText, Params, ParamTypes, Options);
|
|
finally
|
|
lT.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
|
|
begin
|
|
Result := TObjectList<T>.Create(True);
|
|
try
|
|
Select<T>(SQL, Params, ParamTypes, Options, Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectOne<T>(const SQL: string; const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := SelectOne<T>(SQL, Params, [], [], RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectOne<T>(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
var
|
|
lList: TObjectList<T>;
|
|
begin
|
|
lList := Select<T>(SQL, Params, ParamTypes, Options);
|
|
try
|
|
if (lList.Count = 0) then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected')
|
|
else
|
|
Exit(nil);
|
|
end;
|
|
if lList.Count > 1 then
|
|
begin
|
|
raise EMVCActiveRecordNotFound.CreateFmt('Got %d rows when exactly 1 was expected', [lList.Count]);
|
|
end;
|
|
Result := lList.Extract(lList.First);
|
|
finally
|
|
lList.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectRQL<T>(const RQL: string; const MaxRecordCount: Integer): TObjectList<T>;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
lSQL: string;
|
|
begin
|
|
lAR := T.Create;
|
|
try
|
|
lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping, MaxRecordCount > -1, false, MaxRecordCount).Trim;
|
|
lSQL := TMVCSQLGenerator.RemoveInitialWhereKeyword(lSQL);
|
|
Result := Where<T>(lSQL, []);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType): TObjectList<T>;
|
|
begin
|
|
Result := TObjectList<T>.Create(True);
|
|
try
|
|
Where<T>(SQLWhere, Params, ParamTypes, Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
|
|
const MaxRecordCount: Integer): TMVCActiveRecordList;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create(True);
|
|
try
|
|
Result := lAR.InternalSelectRQL(RQL, MaxRecordCount);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetAttributes(const AttrName: string; const Value: TValue);
|
|
var
|
|
lProperty: TRttiProperty;
|
|
begin
|
|
if not TRttiUtils.ExistsProperty(Self, AttrName, lProperty) then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('Attribute [%s] not found', [AttrName]);
|
|
end;
|
|
SetPropertyValue(lProperty, Value);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetPropertyValue(const aProp: TRttiProperty; const aValue: TValue);
|
|
var
|
|
lCurrValue: TValue;
|
|
lNullableString: NullableString;
|
|
lNullableUInt32: NullableUInt32;
|
|
lNullableUInt64: NullableUInt64;
|
|
lNullableInt64: NullableInt64;
|
|
lNullableBoolean: NullableBoolean;
|
|
lNullableTDateTime: NullableTDateTime;
|
|
lNullableTDate: NullableTDate;
|
|
lNullableTTime: NullableTTime;
|
|
begin
|
|
if aProp.GetValue(Self).Kind = tkRecord then
|
|
begin
|
|
lCurrValue := aProp.GetValue(Self);
|
|
if lCurrValue.IsType<NullableInt32> then
|
|
begin
|
|
if aValue.IsType<NullableInt32>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lCurrValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
|
|
end
|
|
end
|
|
else if lCurrValue.IsType<NullableInt64> then
|
|
begin
|
|
if aValue.IsType<NullableInt64>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lNullableInt64 := aValue.AsInt64;
|
|
lCurrValue := TValue.From<NullableInt64>(lNullableInt64);
|
|
end;
|
|
end
|
|
else if lCurrValue.IsType<NullableString> then
|
|
begin
|
|
if aValue.IsType<NullableString>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lNullableString := aValue.AsString;
|
|
lCurrValue := TValue.From<NullableString>(lNullableString);
|
|
end;
|
|
end
|
|
else if lCurrValue.IsType<NullableUInt32> then
|
|
begin
|
|
if aValue.IsType<NullableUInt32>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lNullableUInt32 := aValue.AsInteger;
|
|
lCurrValue.From<NullableUInt32>(lNullableUInt32);
|
|
end;
|
|
end
|
|
else if lCurrValue.IsType<NullableUInt64> then
|
|
begin
|
|
if aValue.IsType<NullableUInt64>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lNullableUInt64 := aValue.AsUInt64;
|
|
lCurrValue.From<NullableUInt64>(lNullableUInt64);
|
|
end;
|
|
end
|
|
else if lCurrValue.IsType<NullableBoolean> then
|
|
begin
|
|
if aValue.IsType<NullableBoolean>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lNullableBoolean := aValue.AsBoolean;
|
|
lCurrValue.From<NullableBoolean>(lNullableBoolean);
|
|
end;
|
|
end
|
|
else if lCurrValue.IsType<NullableTDateTime> then
|
|
begin
|
|
if aValue.IsType<NullableTDateTime>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
{$IF Defined(TOKYOORBETTER)}
|
|
lNullableTDateTime := TDateTime(aValue.AsExtended);
|
|
{$ELSE}
|
|
lNullableTDateTime := aValue.AsExtended;
|
|
{$ENDIF}
|
|
lCurrValue.From<NullableTDateTime>(lNullableTDateTime);
|
|
end;
|
|
end
|
|
else if lCurrValue.IsType<NullableTDate> then
|
|
begin
|
|
if aValue.IsType<NullableTDate>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
{$IF Defined(TOKYOORBETTER)}
|
|
lNullableTDate := TDate(aValue.AsExtended);
|
|
{$ELSE}
|
|
lNullableTDate := aValue.AsExtended;
|
|
{$ENDIF}
|
|
lCurrValue.From<NullableTDate>(lNullableTDate);
|
|
end;
|
|
end
|
|
else if lCurrValue.IsType<NullableTTime> then
|
|
begin
|
|
if aValue.IsType<NullableTTime>() then
|
|
begin
|
|
lCurrValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
{$IF Defined(TOKYOORBETTER)}
|
|
lNullableTTime := TTime(aValue.AsExtended);
|
|
{$ELSE}
|
|
lNullableTTime := aValue.AsExtended;
|
|
{$ENDIF}
|
|
lCurrValue.From<NullableTTime>(lNullableTTime);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create('Invalid data type for dynamic property access');
|
|
end;
|
|
aProp.SetValue(Self, lCurrValue);
|
|
end
|
|
else
|
|
begin
|
|
aProp.SetValue(Self, aValue)
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetPK(const aValue: TValue);
|
|
var
|
|
lPKValue: TValue;
|
|
begin
|
|
if fTableMap.fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
raise Exception.Create('No primary key defined');
|
|
end;
|
|
|
|
if fTableMap.fPrimaryKey.GetValue(Self).Kind = tkRecord then
|
|
begin
|
|
lPKValue := fTableMap.fPrimaryKey.GetValue(Self);
|
|
if lPKValue.IsType<NullableInt32> { and aValue.IsType<NullableInt32>() } then
|
|
begin
|
|
if aValue.IsType<Int32> then
|
|
begin
|
|
lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create('Invalid type for primary key');
|
|
end;
|
|
end
|
|
else if lPKValue.IsType<NullableInt64> and aValue.IsType<NullableInt64>() then
|
|
begin
|
|
if aValue.AsType<NullableInt64>().HasValue then
|
|
begin
|
|
lPKValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lPKValue.AsType<NullableInt64>().Clear;
|
|
end;
|
|
end
|
|
else if lPKValue.IsType<NullableString> and aValue.IsType<NullableString>() then
|
|
begin
|
|
if aValue.AsType<NullableString>().HasValue then
|
|
begin
|
|
lPKValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lPKValue.AsType<NullableString>().Clear;
|
|
end;
|
|
end
|
|
else if lPKValue.IsType<NullableUInt32> and aValue.IsType<NullableUInt32>() then
|
|
begin
|
|
if aValue.AsType<NullableUInt32>().HasValue then
|
|
begin
|
|
lPKValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lPKValue.AsType<NullableUInt32>().Clear;
|
|
end;
|
|
end
|
|
else if lPKValue.IsType<NullableUInt64> and aValue.IsType<NullableUInt64>() then
|
|
begin
|
|
if aValue.AsType<NullableUInt64>().HasValue then
|
|
begin
|
|
lPKValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lPKValue.AsType<NullableUInt64>().Clear;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create
|
|
('Invalid type for primary key [HINT] Double check if TypeInfo(PK) is equal to TypeInfo(Value)');
|
|
end;
|
|
fTableMap.fPrimaryKey.SetValue(Self, lPKValue);
|
|
end
|
|
else
|
|
begin
|
|
fTableMap.fPrimaryKey.SetValue(Self, aValue)
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetPrimaryKeyIsAutogenerated(const Value: Boolean);
|
|
begin
|
|
if Value then
|
|
begin
|
|
Include(fTableMap.fPrimaryKeyOptions, foAutoGenerated);
|
|
end
|
|
else
|
|
begin
|
|
Exclude(fTableMap.fPrimaryKeyOptions, foAutoGenerated);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetInitialObjVersion(const TableMap: TMVCTableMap;
|
|
const ARInstance: TMVCActiveRecord);
|
|
begin
|
|
TableMap.fVersionRTTIField.SetValue(ARInstance, OBJECT_VERSION_STARTING_VALUE_AS_INT);
|
|
end;
|
|
|
|
function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator;
|
|
var
|
|
lSQLGeneratorClass: TMVCSQLGeneratorClass;
|
|
begin
|
|
if not Assigned(fSQLGenerator) then
|
|
begin
|
|
GetConnection.Connected := True;
|
|
lSQLGeneratorClass := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd);
|
|
fSQLGenerator := lSQLGeneratorClass.Create(GetMapping, fTableMap.fDefaultRQLFilter, GetPartitionInfo);
|
|
end;
|
|
Result := fSQLGenerator;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Store;
|
|
var
|
|
lValue: TValue;
|
|
lRes: Boolean;
|
|
lIsNullableType: Boolean;
|
|
begin
|
|
lRes := TryGetPKValue(lValue, lIsNullableType);
|
|
if not lIsNullableType then
|
|
begin
|
|
raise EMVCActiveRecord.Create('Store can be used only with nullable PKs [HINT] Use NullableInt64 as PK');
|
|
end;
|
|
if lRes then
|
|
begin
|
|
Update;
|
|
end
|
|
else
|
|
begin
|
|
Insert;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.TableInfo: string;
|
|
var
|
|
KeyValue: TPair<TRTTIField, TFieldInfo>;
|
|
begin
|
|
Result := 'Table Name: ' + TableName;
|
|
for KeyValue in fTableMap.fMap do
|
|
Result := Result + sLineBreak + #9 + KeyValue.Key.Name + ' = ' + KeyValue.Value.FieldName;
|
|
end;
|
|
|
|
function TMVCActiveRecord.TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean;
|
|
begin
|
|
IsNullableType := false;
|
|
if fTableMap.fPrimaryKeyFieldName.IsEmpty then
|
|
raise Exception.Create('No primary key defined');
|
|
Value := fTableMap.fPrimaryKey.GetValue(Self);
|
|
if Value.Kind = tkRecord then
|
|
begin
|
|
if Value.IsType<NullableInt32>() then
|
|
begin
|
|
Result := Value.AsType<NullableInt32>().TryHasValue(Value);
|
|
end
|
|
else if Value.IsType<NullableInt64>() then
|
|
begin
|
|
Result := Value.AsType<NullableInt64>().TryHasValue(Value)
|
|
end
|
|
else if Value.IsType<NullableUInt32>() then
|
|
begin
|
|
Result := Value.AsType<NullableUInt32>().TryHasValue(Value)
|
|
end
|
|
else if Value.IsType<NullableUInt64>() then
|
|
begin
|
|
Result := Value.AsType<NullableUInt64>().TryHasValue(Value)
|
|
end
|
|
else if Value.IsType<NullableInt16>() then
|
|
begin
|
|
Result := Value.AsType<NullableInt16>().TryHasValue(Value)
|
|
end
|
|
else if Value.IsType<NullableUInt16>() then
|
|
begin
|
|
Result := Value.AsType<NullableUInt16>().TryHasValue(Value)
|
|
end
|
|
else if Value.IsType<NullableString>() then
|
|
begin
|
|
Result := Value.AsType<NullableString>().TryHasValue(Value)
|
|
end
|
|
else if Value.IsType<NullableTGUID>() then
|
|
begin
|
|
Result := Value.AsType<NullableTGUID>().TryHasValue(Value)
|
|
end
|
|
else
|
|
raise EMVCActiveRecord.Create
|
|
('Invalid primary key type [HINT: Use Int64, String, NullableInt64 or NullableString, so that Store method is available too.]');
|
|
IsNullableType := True;
|
|
end
|
|
else
|
|
begin
|
|
Result := not Value.IsEmpty;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Update(const RaiseExceptionIfNotFound: Boolean = True);
|
|
var
|
|
SQL: string;
|
|
lAffectedRows: int64;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaUpdate);
|
|
OnValidation(TMVCEntityAction.eaUpdate);
|
|
OnBeforeUpdate;
|
|
OnBeforeInsertOrUpdate;
|
|
if fTableMap.fMap.WritableFieldsCount = 0 then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Cannot update an entity if no fields are writeable. Class [%s] mapped on table [%s]', [ClassName, TableName]);
|
|
end;
|
|
SQL := SQLGenerator.CreateUpdateSQL(fTableMap, Self);
|
|
lAffectedRows := ExecNonQuery(SQL, false);
|
|
if (lAffectedRows = 0) and RaiseExceptionIfNotFound then
|
|
begin
|
|
if fTableMap.fIsVersioned then
|
|
begin
|
|
raise EMVCActiveRecordVersionedItemNotFound.CreateFmt('No record updated for key [Entity: %s][PK: %s][Version: %d] - record or version not found',
|
|
[ClassName, fTableMap.fPrimaryKeyFieldName, fTableMap.VersionValueAsInt64For(Self)]);
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecordNotFound.CreateFmt('No record updated for key [Entity: %s][PK: %s]',
|
|
[ClassName, fTableMap.fPrimaryKeyFieldName]);
|
|
end;
|
|
end;
|
|
if fTableMap.fIsVersioned then
|
|
begin
|
|
AdvanceVersioning(fTableMap, Self);
|
|
end;
|
|
OnAfterUpdate;
|
|
OnAfterInsertOrUpdate;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass;
|
|
const SQLWhere: string; const Params: array of Variant;
|
|
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection, OutList);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.AddChildren(const ChildObject: TObject);
|
|
begin
|
|
if fChildren = nil then
|
|
begin
|
|
fChildren := TObjectList<TObject>.Create(True);
|
|
end;
|
|
if not(fChildren.Contains(ChildObject)) and (not(ChildObject = Self)) then
|
|
begin
|
|
fChildren.Add(ChildObject);
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
Result := Select(aClass,
|
|
lAR.GenerateSelectSQL + lAR.SQLGenerator.GetDefaultSQLFilter(True), []);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.AdvanceVersioning(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord);
|
|
var
|
|
lCurrVersion: Int64;
|
|
begin
|
|
lCurrVersion := TableMap.VersionValueAsInt64For(ARInstance);
|
|
Inc(lCurrVersion);
|
|
TableMap.fVersionRTTIField.SetValue(ARInstance, lCurrVersion);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Assign(ActiveRecord: TMVCActiveRecord);
|
|
begin
|
|
//do nothing
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.All(const aQualifiedClassName: String): TObjectList<TMVCActiveRecord>;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := TMVCActiveRecord.CreateMVCActiveRecord<TMVCActiveRecord>(aQualifiedClassName, []);
|
|
try
|
|
Result := Select(TMVCActiveRecordClass(lAR.ClassType),
|
|
lAR.GenerateSelectSQL + lAR.SQLGenerator.GetDefaultSQLFilter(True), []);
|
|
finally
|
|
lAr.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.All<T>: TObjectList<T>;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := T.Create;
|
|
try
|
|
Result := Select<T>(
|
|
lAR.GenerateSelectSQL + lAR.SQLGenerator.GetDefaultSQLFilter(True), []);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
|
|
const Params: array of Variant): TMVCActiveRecordList;
|
|
begin
|
|
Result := Where(aClass, SQLWhere, Params, nil);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
|
|
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
|
|
begin
|
|
Result := TMVCActiveRecordList.Create;
|
|
try
|
|
Where(aClass, SQLWhere, Params, Connection, Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string; const Params: array of Variant): TObjectList<T>;
|
|
begin
|
|
Result := Where<T>(SQLWhere, Params, []);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Merge<T>(CurrentList, NewList: TObjectList<T>; const MergeMode: TMergeMode): IMVCMultiExecutor<T>;
|
|
var
|
|
I: Integer;
|
|
lFoundAtIndex: Integer;
|
|
lUnitOfWork: IMVCUnitOfWork<T>;
|
|
lPKType: TFieldType;
|
|
lNeedsToBeUpdated: Boolean;
|
|
begin
|
|
lUnitOfWork := TMVCUnitOfWork<T>.Create;
|
|
if mmDelete in MergeMode then
|
|
begin
|
|
lUnitOfWork.RegisterDelete(CurrentList);
|
|
end;
|
|
if NewList.Count > 0 then
|
|
begin
|
|
lPKType := NewList[0].GetPrimaryKeyFieldType;
|
|
for I := 0 to NewList.Count - 1 do
|
|
begin
|
|
if NewList[I].PKIsNull then
|
|
begin
|
|
if mmInsert in MergeMode then
|
|
begin
|
|
lUnitOfWork.RegisterInsert(NewList[I]);
|
|
end;
|
|
Continue;
|
|
end;
|
|
|
|
case lPKType of
|
|
ftString:
|
|
begin
|
|
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsString(CurrentList, NewList[I].GetPK.AsString,
|
|
lFoundAtIndex);
|
|
end;
|
|
ftInteger:
|
|
begin
|
|
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt(CurrentList, NewList[I].GetPK.AsInteger, lFoundAtIndex);
|
|
end;
|
|
ftLargeInt:
|
|
begin
|
|
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt64(CurrentList, NewList[I].GetPK.AsInt64, lFoundAtIndex);
|
|
end;
|
|
else
|
|
raise EMVCActiveRecord.Create('Invalid primary key type for merge');
|
|
end;
|
|
|
|
if lNeedsToBeUpdated then
|
|
begin
|
|
if mmUpdate in MergeMode then
|
|
begin
|
|
lUnitOfWork.RegisterUpdate(NewList[I])
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if mmInsert in MergeMode then
|
|
begin
|
|
lUnitOfWork.RegisterInsert(NewList[I]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := lUnitOfWork as IMVCMultiExecutor<T>;
|
|
end;
|
|
|
|
{ TMVCEntitiesRegistry }
|
|
|
|
procedure TMVCEntitiesRegistry.AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
|
|
begin
|
|
fEntitiesDict.AddOrSetValue(aURLSegment.ToLower, aActiveRecordClass);
|
|
end;
|
|
|
|
procedure TMVCEntitiesRegistry.AddEntityProcessor(const aURLSegment: string;
|
|
const aEntityProcessor: IMVCEntityProcessor);
|
|
begin
|
|
fProcessorsDict.Add(aURLSegment, aEntityProcessor);
|
|
end;
|
|
|
|
constructor TMVCEntitiesRegistry.Create;
|
|
begin
|
|
inherited;
|
|
fEntitiesDict := TDictionary<string, TMVCActiveRecordClass>.Create;
|
|
fProcessorsDict := TDictionary<string, IMVCEntityProcessor>.Create;
|
|
end;
|
|
|
|
destructor TMVCEntitiesRegistry.Destroy;
|
|
begin
|
|
fEntitiesDict.Free;
|
|
fProcessorsDict.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TMVCEntitiesRegistry.FindEntityClassByURLSegment(const aURLSegment: string;
|
|
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
|
|
begin
|
|
Result := fEntitiesDict.TryGetValue(aURLSegment.ToLower, aMVCActiveRecordClass);
|
|
end;
|
|
|
|
function TMVCEntitiesRegistry.FindProcessorByURLSegment(const aURLSegment: string;
|
|
out aMVCEntityProcessor: IMVCEntityProcessor): Boolean;
|
|
begin
|
|
Result := fProcessorsDict.TryGetValue(aURLSegment.ToLower, aMVCEntityProcessor);
|
|
end;
|
|
|
|
function TMVCEntitiesRegistry.GetEntities: TArray<String>;
|
|
begin
|
|
Result := fEntitiesDict.Keys.ToArray;
|
|
end;
|
|
|
|
function TMVCEntitiesRegistry.GetURLSegmentWithEntities: TArray<TMVCEntityMapping>;
|
|
var
|
|
lPair: TMVCEntityMapping;
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result, fEntitiesDict.Count);
|
|
i := 0;
|
|
for lPair in fEntitiesDict do
|
|
begin
|
|
Result[I] := lPair;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
{ EMVCActiveRecord }
|
|
|
|
constructor EMVCActiveRecord.Create(const AMsg: string);
|
|
begin
|
|
inherited Create(http_status.BadRequest, AMsg);
|
|
end;
|
|
|
|
{ EntityActionsAttribute }
|
|
|
|
constructor MVCEntityActionsAttribute.Create(const aEntityAllowedActions: TMVCEntityActions);
|
|
begin
|
|
inherited Create;
|
|
EntityAllowedActions := aEntityAllowedActions;
|
|
end;
|
|
|
|
{ TMVCActiveRecordList }
|
|
|
|
constructor TMVCActiveRecordList.Create;
|
|
begin
|
|
inherited Create(True);
|
|
end;
|
|
|
|
{ TMVCSQLGeneratorRegistry }
|
|
|
|
constructor TMVCSQLGeneratorRegistry.Create;
|
|
begin
|
|
inherited;
|
|
fSQLGenerators := TDictionary<string, TMVCSQLGeneratorClass>.Create;
|
|
end;
|
|
|
|
class constructor TMVCSQLGeneratorRegistry.Create;
|
|
begin
|
|
cConnectionsLock := TObject.Create;
|
|
end;
|
|
|
|
class destructor TMVCSQLGeneratorRegistry.Destroy;
|
|
begin
|
|
cInstance.Free;
|
|
cConnectionsLock.Free;
|
|
end;
|
|
|
|
destructor TMVCSQLGeneratorRegistry.Destroy;
|
|
begin
|
|
fSQLGenerators.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TMVCSQLGeneratorRegistry.GetSQLGenerator(const aBackend: string): TMVCSQLGeneratorClass;
|
|
begin
|
|
if not fSQLGenerators.TryGetValue(aBackend, Result) then
|
|
begin
|
|
raise ERQLCompilerNotFound.CreateFmt('SQLGenerator not found for "%s". [HINT] Include unit "MVCFramework.SQLGenerators.%s.pas" somewhere in the project code, if available.', [aBackend, aBackend]);
|
|
end;
|
|
end;
|
|
|
|
class function TMVCSQLGeneratorRegistry.Instance: TMVCSQLGeneratorRegistry;
|
|
begin
|
|
if not Assigned(cInstance) then
|
|
begin
|
|
TMonitor.Enter(cConnectionsLock);
|
|
try
|
|
if not Assigned(cInstance) then
|
|
begin
|
|
cInstance := TMVCSQLGeneratorRegistry.Create;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(cConnectionsLock);
|
|
end;
|
|
end;
|
|
Result := cInstance;
|
|
end;
|
|
|
|
procedure TMVCSQLGeneratorRegistry.RegisterSQLGenerator(const aBackend: string;
|
|
const aRQLBackendClass: TMVCSQLGeneratorClass);
|
|
begin
|
|
fSQLGenerators.AddOrSetValue(aBackend, aRQLBackendClass);
|
|
end;
|
|
|
|
procedure TMVCSQLGeneratorRegistry.UnRegisterSQLGenerator(const aBackend: string);
|
|
begin
|
|
fSQLGenerators.Remove(aBackend);
|
|
end;
|
|
|
|
{ TMVCSQLGenerator }
|
|
|
|
constructor TMVCSQLGenerator.Create(Mapping: TMVCFieldsMapping; const DefaultRQLFilter: string;
|
|
const PartitionInfo: TPartitionInfo);
|
|
begin
|
|
inherited Create;
|
|
fMapping := Mapping;
|
|
fDefaultRQLFilter := DefaultRQLFilter;
|
|
fPartitionInfo := PartitionInfo;
|
|
GetCompiler;
|
|
if not fDefaultRQLFilter.IsEmpty then
|
|
begin
|
|
GetRQLParser.Execute(fDefaultRQLFilter, fDefaultSQLFilter, GetCompiler, false, True);
|
|
fDefaultSQLFilter := TMVCSQLGenerator.RemoveInitialWhereKeyword(fDefaultSQLFilter);
|
|
end;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetMapping: TMVCFieldsMapping;
|
|
begin
|
|
Result := fMapping;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetParamNameForSQL(const FieldName: string): string;
|
|
begin
|
|
Result := fCompiler.GetParamNameForSQL(FieldName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.CreateDeleteAllSQL(const TableName: string): string;
|
|
begin
|
|
Result := 'DELETE FROM ' + GetTableNameForSQL(TableName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.CreateDeleteSQL(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord): string;
|
|
begin
|
|
Result := CreateDeleteAllSQL(TableMap.fTableName) + ' WHERE ' + GetFieldNameForSQL(TableMap.fPrimaryKeyFieldName) + '=:' +
|
|
GetParamNameForSQL(TableMap.fPrimaryKeyFieldName);
|
|
if TableMap.fIsVersioned then
|
|
begin
|
|
Result := Result + ' and ' + GetFieldNameForSQL(TableMap.fVersionFieldName) + ' = ' + IntToStr(TableMap.VersionValueAsInt64For(ARInstance));
|
|
end;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.CreateSelectByPKSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): string;
|
|
begin
|
|
if PKFieldName.IsEmpty then
|
|
begin
|
|
raise EMVCActiveRecord.Create
|
|
('No primary key provided. [HINT] Define a primary key field adding foPrimaryKey in field options.');
|
|
end;
|
|
|
|
Result := CreateSelectSQL(TableName, Map, PKFieldName, PKOptions) + ' WHERE ' + GetFieldNameForSQL(PKFieldName) +
|
|
'= :' + GetParamNameForSQL(PKFieldName) + GetDefaultSQLFilter(false, True);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.CreateSelectCount(const TableName: string): string;
|
|
begin
|
|
{ do not add SQLFilter here! }
|
|
Result := 'SELECT count(*) FROM ' + GetTableNameForSQL(TableName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.CreateSelectSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): string;
|
|
begin
|
|
Result := 'SELECT ' + TableFieldsDelimited(Map, PKFieldName, ',') + ' FROM ' + GetTableNameForSQL(TableName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping;
|
|
const UseArtificialLimit, UseFilterOnly: Boolean; const MaxRecordCount: Int32): string;
|
|
begin
|
|
GetRQLParser.Execute(MergeDefaultRQLFilter(RQL), Result, GetCompiler, UseArtificialLimit, UseFilterOnly,
|
|
MaxRecordCount);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.CreateUpdateSQL(const TableMap: TMVCTableMap; const ARInstance: TMVCActiveRecord): string;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
// I: Integer;
|
|
begin
|
|
Result := 'UPDATE ' + GetTableNameForSQL(TableMap.fTableName) + ' SET ';
|
|
for lPair in TableMap.fMap do
|
|
begin
|
|
if lPair.Value.IsVersion then
|
|
begin
|
|
Result := Result + GetFieldNameForSQL(lPair.Value.FieldName) + ' = ' +
|
|
GetParamNameForSQL(lPair.Value.FieldName) + ' + 1,';
|
|
end else if lPair.Value.Updatable then
|
|
begin
|
|
Result := Result + GetFieldNameForSQL(lPair.Value.FieldName) + ' = :' +
|
|
GetParamNameForSQL(lPair.Value.FieldName) + ',';
|
|
end;
|
|
end;
|
|
{ partition }
|
|
// for I := 0 to fPartitionInfo.FieldNames.Count - 1 do
|
|
// begin
|
|
// Result := Result + GetFieldNameForSQL(fPartitionInfo.FieldNames[I]) + ' = :' +
|
|
// GetParamNameForSQL(fPartitionInfo.FieldNames[I]) + ',';
|
|
// end;
|
|
{ end-partitioning }
|
|
Result[Length(Result)] := ' ';
|
|
if not TableMap.fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
Result := Result + ' where ' +
|
|
GetFieldNameForSQL(TableMap.fPrimaryKeyFieldName) + '= :' + GetParamNameForSQL(TableMap.fPrimaryKeyFieldName);
|
|
if TableMap.fIsVersioned then
|
|
begin
|
|
Result := Result + ' and ' + GetFieldNameForSQL(TableMap.fVersionFieldName) +
|
|
' = ' + TableMap.VersionValueAsInt64For(ARInstance).ToString
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create('Cannot perform an update without an entity primary key');
|
|
end;
|
|
end;
|
|
|
|
destructor TMVCSQLGenerator.Destroy;
|
|
begin
|
|
fCompiler.Free;
|
|
fRQL2SQL.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetCompiler: TRQLCompiler;
|
|
begin
|
|
if fCompiler = nil then
|
|
begin
|
|
fCompiler := GetCompilerClass.Create(fMapping);
|
|
end;
|
|
Result := fCompiler;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetDefaultSQLFilter(const IncludeWhereClause: Boolean;
|
|
const IncludeAndClauseBeforeFilter: Boolean): String;
|
|
begin
|
|
Result := MergeSQLFilter(fPartitionInfo.SQLFilter, fDefaultSQLFilter);
|
|
if not Result.IsEmpty then
|
|
begin
|
|
if IncludeWhereClause then
|
|
begin
|
|
Result := ' WHERE ' + Result;
|
|
end
|
|
else
|
|
begin
|
|
if IncludeAndClauseBeforeFilter then
|
|
Result := ' and ' + Result;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetFieldNameForSQL(const FieldName: string): string;
|
|
begin
|
|
Result := fCompiler.GetFieldNameForSQL(FieldName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetRQLParser: TRQL2SQL;
|
|
begin
|
|
if fRQL2SQL = nil then
|
|
begin
|
|
fRQL2SQL := TRQL2SQL.Create;
|
|
end;
|
|
Result := fRQL2SQL;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetSequenceValueSQL(const PKFieldName: string; const SequenceName: string;
|
|
const Step: Integer = 1): string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetTableNameForSQL(const TableName: string): string;
|
|
begin
|
|
Result := fCompiler.GetTableNameForSQL(TableName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.HasNativeUUID: Boolean;
|
|
begin
|
|
Result := false;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.HasReturning: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.HasSequences: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.MergeDefaultRQLFilter(const RQL: String): String;
|
|
var
|
|
lRQLFilterPart, lRQLSortingAndLimitPart: String;
|
|
lSemicolonPos: Integer;
|
|
begin
|
|
lRQLFilterPart := RQL;
|
|
lRQLSortingAndLimitPart := '';
|
|
lSemicolonPos := RQL.IndexOf(';');
|
|
if lSemicolonPos > -1 then
|
|
begin
|
|
lRQLFilterPart := RQL.Substring(0, lSemicolonPos);
|
|
lRQLSortingAndLimitPart := RQL.Substring(lSemicolonPos + 1, 1000);
|
|
end;
|
|
|
|
{ this is not the best solution, but it works... }
|
|
if lRQLFilterPart.Contains('sort') or lRQLFilterPart.Contains('limit') then
|
|
begin
|
|
lRQLSortingAndLimitPart := lRQLFilterPart;
|
|
lRQLFilterPart := '';
|
|
end;
|
|
|
|
if (not fDefaultRQLFilter.IsEmpty) or (not fPartitionInfo.RQLFilter.IsEmpty) then
|
|
begin
|
|
Result := 'and(';
|
|
if not fDefaultRQLFilter.IsEmpty then
|
|
begin
|
|
Result := Result + fDefaultRQLFilter;
|
|
end;
|
|
if not fPartitionInfo.RQLFilter.IsEmpty then
|
|
begin
|
|
Result := Result + ',' + fPartitionInfo.RQLFilter;
|
|
end;
|
|
if not lRQLFilterPart.IsEmpty then
|
|
begin
|
|
Result := Result + ',' + lRQLFilterPart;
|
|
end;
|
|
Result := Result + ')';
|
|
end
|
|
else
|
|
begin
|
|
Exit(RQL);
|
|
end;
|
|
|
|
if not lRQLSortingAndLimitPart.IsEmpty then
|
|
begin
|
|
Result := Result + ';' + lRQLSortingAndLimitPart;
|
|
end;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.MergeSQLFilter(const PartitionSQL, FilteringSQL: String): String;
|
|
begin
|
|
Result := '';
|
|
if PartitionSQL + FilteringSQL = '' then
|
|
begin
|
|
Exit;
|
|
end;
|
|
//if PartitionSQL.IsEmpty and (not FilteringSQL.IsEmpty) then
|
|
if not FilteringSQL.IsEmpty then
|
|
begin
|
|
Exit(FilteringSQL); //ignore partitioning while reading if filtering is present
|
|
end;
|
|
if FilteringSQL.IsEmpty and (not PartitionSQL.IsEmpty) then
|
|
begin
|
|
Exit(PartitionSQL);
|
|
end;
|
|
// Result := '((' + PartitionSQL + ') and (' + FilteringSQL + '))';
|
|
end;
|
|
|
|
class function TMVCSQLGenerator.RemoveInitialWhereKeyword(const SQLFilter: String): String;
|
|
begin
|
|
Result := SQLFilter.TrimLeft;
|
|
if Result.StartsWith('where', True) then
|
|
begin
|
|
Result := Result.Remove(0, 5);
|
|
end;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.TableFieldsDelimited(const Map: TFieldsMap; const PKFieldName: string;
|
|
const Delimiter: string): string;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
begin
|
|
for lPair in Map do
|
|
begin
|
|
if lPair.Value.Selectable then
|
|
begin
|
|
Result := Result + GetFieldNameForSQL(lPair.Value.FieldName) + Delimiter;
|
|
end;
|
|
end;
|
|
Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
|
|
if not PKFieldName.IsEmpty then
|
|
begin
|
|
if not Result.IsEmpty then
|
|
begin
|
|
Result := GetFieldNameForSQL(PKFieldName) + ', ' + Result
|
|
end
|
|
else
|
|
begin
|
|
Result := GetFieldNameForSQL(PKFieldName)
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TMVCConnectionsRepository.TConnHolder }
|
|
|
|
destructor TMVCConnectionsRepository.TConnHolder.Destroy;
|
|
begin
|
|
if OwnsConnection then
|
|
begin
|
|
if Connection.Connected then
|
|
Connection.Connected := false;
|
|
FreeAndNil(Connection);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
constructor MVCTableFieldAttribute.Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions;
|
|
const aSequenceName: string; const aDataTypeName: string);
|
|
begin
|
|
inherited Create;
|
|
FieldName := aFieldName;
|
|
FieldOptions := aFieldOptions;
|
|
SequenceName := aSequenceName;
|
|
DataTypeName := aDataTypeName;
|
|
end;
|
|
|
|
{ EMVCActiveRecordNotFound }
|
|
|
|
procedure EMVCActiveRecordNotFound.AfterConstruction;
|
|
begin
|
|
inherited;
|
|
FHTTPStatusCode := http_status.NotFound;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType;
|
|
const Connection: TFDConnection;
|
|
const Unidirectional: Boolean;
|
|
const DirectExecute: Boolean): TDataSet;
|
|
var
|
|
lQry: TFDQuery;
|
|
begin
|
|
lQry := TFDQuery.Create(nil);
|
|
try
|
|
lQry.FetchOptions.Mode := TFDFetchMode.fmAll;
|
|
lQry.FetchOptions.Unidirectional := Unidirectional;
|
|
lQry.UpdateOptions.ReadOnly := True;
|
|
lQry.ResourceOptions.DirectExecute := DirectExecute; //2023-07-12
|
|
|
|
if Connection = nil then
|
|
begin
|
|
lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
end
|
|
else
|
|
begin
|
|
lQry.Connection := Connection;
|
|
end;
|
|
if Length(ValueTypes) = 0 then
|
|
begin
|
|
lQry.Open(SQL, Values);
|
|
end
|
|
else
|
|
begin
|
|
lQry.Open(SQL, Values, ValueTypes);
|
|
end;
|
|
Result := lQry;
|
|
except
|
|
lQry.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional, DirectExecute);
|
|
end;
|
|
|
|
{ TFieldsMap }
|
|
|
|
constructor TFieldsMap.Create;
|
|
begin
|
|
inherited Create([doOwnsValues]);
|
|
fWritableFieldsCount := -1;
|
|
fReadableFieldsCount := -1;
|
|
end;
|
|
|
|
procedure TFieldsMap.EndUpdates;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
begin
|
|
fWritableFieldsCount := 0;
|
|
fReadableFieldsCount := 0;
|
|
for lPair in Self do
|
|
begin
|
|
lPair.Value.EndUpdates;
|
|
if lPair.Value.Insertable or lPair.Value.Updatable then
|
|
begin
|
|
Inc(fWritableFieldsCount);
|
|
end;
|
|
if lPair.Value.Selectable then
|
|
begin
|
|
Inc(fReadableFieldsCount);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFieldsMap.GetInfoByFieldName(const FieldName: string): TFieldInfo;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
begin
|
|
for lPair in Self do
|
|
begin
|
|
if SameText(FieldName, lPair.Value.FieldName) then
|
|
begin
|
|
Result := Items[lPair.Key];
|
|
Exit;
|
|
end;
|
|
end;
|
|
raise EMVCActiveRecord.CreateFmt('FieldName [%s] not found in table', [FieldName]);
|
|
end;
|
|
|
|
{ TFieldInfo }
|
|
|
|
procedure TFieldInfo.EndUpdates;
|
|
begin
|
|
if FieldName.IsEmpty then
|
|
begin
|
|
Selectable := false;
|
|
Insertable := False;
|
|
Updatable := False;
|
|
end
|
|
else
|
|
begin
|
|
Selectable := not (foDoNotSelect in FieldOptions);
|
|
Insertable := [foDoNotInsert, foAutoGenerated] * FieldOptions = [];
|
|
Updatable := [foDoNotUpdate, foAutoGenerated] * FieldOptions = [];
|
|
if foReadOnly in FieldOptions then
|
|
begin
|
|
Insertable := False;
|
|
Updatable := False;
|
|
Selectable := True;
|
|
end;
|
|
end;
|
|
IsVersion := foVersion in FieldOptions;
|
|
end;
|
|
|
|
{ TMVCUnitOfWork<T> }
|
|
|
|
procedure TMVCUnitOfWork<T>.Apply(const ItemApplyAction: TMVCItemApplyAction<T>);
|
|
var
|
|
I: Integer;
|
|
lHandled: Boolean;
|
|
begin
|
|
for I := 0 to fListToInsert.Count - 1 do
|
|
begin
|
|
lHandled := false;
|
|
DoItemApplyAction(fListToInsert[I], eaCreate, ItemApplyAction, lHandled);
|
|
if not lHandled then
|
|
begin
|
|
fListToInsert[I].Insert;
|
|
end;
|
|
end;
|
|
for I := 0 to fListToUpdate.Count - 1 do
|
|
begin
|
|
lHandled := false;
|
|
DoItemApplyAction(fListToUpdate[I], eaUpdate, ItemApplyAction, lHandled);
|
|
if not lHandled then
|
|
begin
|
|
fListToUpdate[I].Update(True);
|
|
end;
|
|
end;
|
|
for I := 0 to fListToDelete.Count - 1 do
|
|
begin
|
|
lHandled := false;
|
|
DoItemApplyAction(fListToDelete[I], eaDelete, ItemApplyAction, lHandled);
|
|
if not lHandled then
|
|
begin
|
|
fListToDelete[I].Delete(True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TMVCUnitOfWork<T>.Create;
|
|
begin
|
|
inherited Create;
|
|
fListToDelete := TObjectList<T>.Create(false);
|
|
fListToUpdate := TObjectList<T>.Create(false);
|
|
fListToInsert := TObjectList<T>.Create(false);
|
|
end;
|
|
|
|
destructor TMVCUnitOfWork<T>.Destroy;
|
|
begin
|
|
fListToDelete.Free;
|
|
fListToUpdate.Free;
|
|
fListToInsert.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.DoItemApplyAction(const Obj: TMVCActiveRecord; const EntityAction: TMVCEntityAction;
|
|
const ItemApplyAction: TMVCItemApplyAction<T>; var Handled: Boolean);
|
|
begin
|
|
if Assigned(ItemApplyAction) then
|
|
begin
|
|
ItemApplyAction(Obj, EntityAction, Handled);
|
|
end;
|
|
end;
|
|
|
|
class function TMVCUnitOfWork<T>.KeyExistsInt(const NewList: TObjectList<T>; const KeyValue: Integer;
|
|
out Index: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := false;
|
|
for I := 0 to NewList.Count - 1 do
|
|
begin
|
|
if NewList[I].GetPK.AsInteger = KeyValue then
|
|
begin
|
|
Index := I;
|
|
Exit(True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCUnitOfWork<T>.KeyExistsInt64(const NewList: TObjectList<T>; const KeyValue: int64;
|
|
out Index: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := false;
|
|
for I := 0 to NewList.Count - 1 do
|
|
begin
|
|
if (not NewList[I].PKIsNull) and (NewList[I].GetPK.AsInt64 = KeyValue) then
|
|
begin
|
|
Index := I;
|
|
Exit(True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCUnitOfWork<T>.KeyExistsString(const NewList: TObjectList<T>; const KeyValue: String;
|
|
out Index: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := false;
|
|
for I := 0 to NewList.Count - 1 do
|
|
begin
|
|
if NewList[I].GetPK.AsString = KeyValue then
|
|
begin
|
|
Index := I;
|
|
Exit(True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.RegisterDelete(const Value: T);
|
|
begin
|
|
fListToDelete.Add(Value);
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.RegisterDelete(const Enumerable: TEnumerable<T>);
|
|
begin
|
|
fListToDelete.AddRange(Enumerable);
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.RegisterInsert(const Value: T);
|
|
begin
|
|
fListToInsert.Add(Value);
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.RegisterUpdate(const Value: T);
|
|
var
|
|
lCurrPKValue: Integer;
|
|
lFoundAtIndex: Integer;
|
|
begin
|
|
fListToUpdate.Add(Value);
|
|
lCurrPKValue := Value.GetPK.AsInteger;
|
|
if KeyExistsInt(fListToDelete, lCurrPKValue, lFoundAtIndex) then
|
|
begin
|
|
fListToDelete.Delete(lFoundAtIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.UnregisterDelete(const Value: T);
|
|
begin
|
|
fListToDelete.Remove(Value);
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.UnregisterInsert(const Value: T);
|
|
begin
|
|
fListToInsert.Remove(Value);
|
|
end;
|
|
|
|
procedure TMVCUnitOfWork<T>.UnregisterUpdate(const Value: T);
|
|
begin
|
|
fListToUpdate.Remove(Value);
|
|
end;
|
|
|
|
constructor MVCTableAttribute.Create(aName, aRQLFilter: String);
|
|
begin
|
|
inherited Create;
|
|
Name := aName;
|
|
RQLFilter := aRQLFilter;
|
|
end;
|
|
|
|
{ MVCPartitionAttribute }
|
|
|
|
constructor MVCPartitionAttribute.Create(const PartitionClause: String);
|
|
begin
|
|
inherited Create;
|
|
Self.PartitionClause := PartitionClause;
|
|
end;
|
|
|
|
{ TPartitionInfo }
|
|
|
|
constructor TPartitionInfo.Create;
|
|
begin
|
|
inherited;
|
|
fFieldNames := TPartitionFieldNames.Create;
|
|
fFieldValues := TPartitionFieldValues.Create;
|
|
fFieldTypes := TPartitionFieldTypes.Create;
|
|
end;
|
|
|
|
destructor TPartitionInfo.Destroy;
|
|
begin
|
|
fFieldNames.Free;
|
|
fFieldValues.Free;
|
|
fFieldTypes.Free;
|
|
inherited;
|
|
end;
|
|
|
|
class destructor TPartitionInfo.Destroy;
|
|
begin
|
|
PartitionInfoCache.Free;
|
|
end;
|
|
|
|
procedure TPartitionInfo.InitializeFilterStrings(const RQLCompiler: TRQLCompiler);
|
|
var
|
|
lFieldCount, I: Integer;
|
|
lRQL2SQL: TRQL2SQL;
|
|
begin
|
|
fRQLFilter := '';
|
|
lFieldCount := FieldNames.Count;
|
|
if lFieldCount > 0 then
|
|
begin
|
|
for I := 0 to lFieldCount - 1 do
|
|
begin
|
|
case FieldTypes[I] of
|
|
ftString:
|
|
begin
|
|
fRQLFilter := fRQLFilter + 'eq(' + FieldNames[I] + ',' + FieldValues[I].QuotedString('"') + '),';
|
|
end;
|
|
ftInteger:
|
|
begin
|
|
fRQLFilter := fRQLFilter + 'eq(' + FieldNames[I] + ',' + FieldValues[I] + '),';
|
|
end;
|
|
else
|
|
raise ERQLException.CreateFmt('DataType for field [%s] not supported in partition clause', [fFieldNames[I]]);
|
|
end;
|
|
end;
|
|
fRQLFilter := fRQLFilter.Remove(fRQLFilter.Length - 1, 1);
|
|
if lFieldCount > 1 then
|
|
begin
|
|
fRQLFilter := 'and(' + fRQLFilter + ')';
|
|
end;
|
|
end;
|
|
lRQL2SQL := TRQL2SQL.Create;
|
|
try
|
|
lRQL2SQL.Execute(fRQLFilter, fSQLFilter, RQLCompiler, false, True)
|
|
finally
|
|
lRQL2SQL.Free;
|
|
end;
|
|
fSQLFilter := TMVCSQLGenerator.RemoveInitialWhereKeyword(fSQLFilter);
|
|
end;
|
|
|
|
class function TPartitionInfo.BuildPartitionClause(const PartitionClause: String;
|
|
const RQLCompilerClass: TRQLCompilerClass): TPartitionInfo;
|
|
var
|
|
lPieces, lItems: TArray<String>;
|
|
lPiece: String;
|
|
lRQLCompiler: TRQLCompiler;
|
|
begin
|
|
{
|
|
Needs to parse [MVCPartition('rating=(integer)4;classname=(string)persona')]
|
|
}
|
|
if not PartitionInfoCache.TryGetValue(PartitionClause + '|' + RQLCompilerClass.ClassName, Result) then
|
|
begin
|
|
TMonitor.Enter(PartitionInfoCache);
|
|
try
|
|
if PartitionInfoCache.TryGetValue(PartitionClause + '|' + RQLCompilerClass.ClassName, Result) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
lRQLCompiler := RQLCompilerClass.Create(nil);
|
|
try
|
|
Result := TPartitionInfo.Create;
|
|
try
|
|
lPieces := PartitionClause.Split([';']);
|
|
for lPiece in lPieces do
|
|
begin
|
|
lItems := lPiece.Split(['=', '(', ')'], TStringSplitOptions.ExcludeEmpty);
|
|
if Length(lItems) <> 3 then
|
|
begin
|
|
raise EMVCActiveRecord.Create('Invalid partitioning clause: ' + lPiece +
|
|
'. [HINT] Partioning must be in the form: "[fieldname1=(integer|string)value1]"');
|
|
end;
|
|
|
|
Result.FieldNames.Add(lItems[0]);
|
|
if lItems[1] = 'integer' then
|
|
Result.FieldTypes.Add(ftInteger)
|
|
else if lItems[1] = 'string' then
|
|
begin
|
|
Result.FieldTypes.Add(ftString)
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create('Unknown data type in partitioning: ' + lItems[1] +
|
|
'. [HINT] data type can be "integer" or "string"');
|
|
end;
|
|
Result.FieldValues.Add(lItems[2]);
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
Result.InitializeFilterStrings(lRQLCompiler);
|
|
PartitionInfoCache.Add(PartitionClause + '|' + RQLCompilerClass.ClassName, Result);
|
|
finally
|
|
lRQLCompiler.Free;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(PartitionInfoCache);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class constructor TPartitionInfo.Create;
|
|
begin
|
|
PartitionInfoCache := TMVCThreadedObjectCache<TPartitionInfo>.Create;
|
|
end;
|
|
|
|
{ TMVCTableMapRepository }
|
|
|
|
procedure TMVCTableMapRepository.AddTableMap(const AR: TMVCActiveRecord; const TableName: String; var TableMap: TMVCTableMap);
|
|
var
|
|
lKey: string;
|
|
{$IF Not Defined(RIOORBETTER)}
|
|
lTmpTableMap: TMVCTableMap;
|
|
{$ENDIF}
|
|
begin
|
|
fMREW.BeginWrite;
|
|
try
|
|
lKey := GetCacheKey(AR, TableName);
|
|
// if, due to multi-threading (and the micro-lock used in the caller),
|
|
// the tablemap definition is already in the case, I free the passed TableMap
|
|
// and return the TableMap already present in the cache.
|
|
LogD(Format('ActiveRecord: Add "%s" to the metadata cache', [lKey]));
|
|
|
|
{$IF Defined(RIOORBETTER)}
|
|
if not fTableMapDict.TryAdd(lKey, TableMap) then
|
|
begin
|
|
LogD(Format('ActiveRecord: Discarded new mapping - cache for "%s" already present', [lKey]));
|
|
TableMap.Free;
|
|
TableMap := fTableMapDict[lKey];
|
|
end;
|
|
{$ELSE}
|
|
// https://github.com/danieleteti/delphimvcframework/issues/728
|
|
if fTableMapDict.TryGetValue(lKey, lTmpTableMap) then
|
|
begin
|
|
LogD(Format('ActiveRecord: Discarded new mapping - cache for "%s" already present', [lKey]));
|
|
TableMap.Free;
|
|
TableMap := lTmpTableMap;
|
|
end
|
|
else
|
|
begin
|
|
fTableMapDict.Add(lKey, TableMap);
|
|
end;
|
|
{$ENDIF}
|
|
finally
|
|
fMREW.EndWrite;
|
|
end;
|
|
end;
|
|
|
|
constructor TMVCTableMapRepository.Create;
|
|
begin
|
|
inherited;
|
|
fMREW := TMultiReadExclusiveWriteSynchronizer.Create;
|
|
fTableMapDict := TObjectDictionary<String, TMVCTableMap>.Create([doOwnsValues]);
|
|
end;
|
|
|
|
destructor TMVCTableMapRepository.Destroy;
|
|
begin
|
|
fTableMapDict.Free;
|
|
fMREW.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMVCTableMapRepository.ExecWithExclusiveLock(Proc: TProc<IMVCActiveRecordTableMap>);
|
|
begin
|
|
fMREW.BeginWrite;
|
|
try
|
|
Proc(Self);
|
|
finally
|
|
fMREW.EndWrite;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCTableMapRepository.FlushCache;
|
|
begin
|
|
ExecWithExclusiveLock(
|
|
procedure(Map: IMVCActiveRecordTableMap)
|
|
begin
|
|
TMVCTableMapRepository(Map).fTableMapDict.Clear;
|
|
end);
|
|
end;
|
|
|
|
function TMVCTableMapRepository.GetCacheKey(const AR: TMVCActiveRecord; const TableName: String): String;
|
|
begin
|
|
Result := AR.QualifiedClassName + ':' + TableName;
|
|
end;
|
|
|
|
function TMVCTableMapRepository.TryGetValue(
|
|
const AR: TMVCActiveRecord;
|
|
const TableName: String;
|
|
out TableMap: TMVCTableMap): Boolean;
|
|
begin
|
|
{$IF not Defined(TokyoOrBetter)}
|
|
Result := nil;
|
|
{$ENDIF}
|
|
fMREW.BeginRead;
|
|
try
|
|
Result := fTableMapDict.TryGetValue(GetCacheKey(AR, TableName), TableMap);
|
|
finally
|
|
fMREW.EndRead;
|
|
end;
|
|
end;
|
|
|
|
{ TMVCTableMap }
|
|
|
|
constructor TMVCTableMap.Create;
|
|
begin
|
|
inherited;
|
|
fMap := TFieldsMap.Create;
|
|
fIsVersioned := False;
|
|
fVersionFieldName := '';
|
|
end;
|
|
|
|
destructor TMVCTableMap.Destroy;
|
|
begin
|
|
fMap.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TMVCTableMap.VersionValueAsInt64For(AR: TMVCActiveRecord): Int64;
|
|
begin
|
|
Result := fVersionRTTIField.GetValue(AR).AsInt64;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select(
|
|
const aClass: TMVCActiveRecordClass;
|
|
const SQL: string; const Params: array of Variant;
|
|
const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32;
|
|
var
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lDataSet := ExecQuery(SQL, Params, Connection, True, False);
|
|
try
|
|
while not lDataSet.Eof do
|
|
begin
|
|
lAR := aClass.Create;
|
|
OutList.Add(lAR);
|
|
lAR.LoadByDataset(lDataSet);
|
|
lDataSet.Next;
|
|
end;
|
|
Result := OutList.Count;
|
|
finally
|
|
lDataSet.Free;
|
|
end;
|
|
end;
|
|
|
|
{ MVCNamedSQLQueryAttribute }
|
|
|
|
constructor MVCNamedSQLQueryAttribute.Create(aName, aSQLSelect: String);
|
|
begin
|
|
Create(aName, aSQLSelect, '');
|
|
end;
|
|
|
|
constructor MVCNamedSQLQueryAttribute.Create(aName, aSQLSelect,
|
|
aBackEnd: String);
|
|
begin
|
|
inherited Create;
|
|
Name := aName;
|
|
SQLQuery := aSQLSelect;
|
|
BackEnd := aBackEnd;
|
|
end;
|
|
|
|
{ MVCNamedRQLQueryAttribute }
|
|
|
|
constructor MVCNamedRQLQueryAttribute.Create(aName, aRQL: String);
|
|
begin
|
|
inherited Create;
|
|
Name := aName;
|
|
RQLQuery := aRQL;
|
|
end;
|
|
|
|
constructor TMVCActiveRecord.Create;
|
|
begin
|
|
Create(True);
|
|
end;
|
|
|
|
{ TMVCTransactionContext }
|
|
|
|
{$IF Defined(CUSTOM_MANAGED_RECORDS)}
|
|
|
|
constructor TMVCTransactionContext.Create(Dummy: Integer);
|
|
begin
|
|
fConnection := nil;
|
|
end;
|
|
|
|
class operator TMVCTransactionContext.Assign(var Dest: TMVCTransactionContext; const [ref] Src: TMVCTransactionContext);
|
|
begin
|
|
if Assigned(Src.fConnection) then
|
|
begin
|
|
Dest.fConnection := nil;
|
|
raise EMVCActiveRecordTransactionContext.Create('Transaction Context cannot be copied nor passed by value');
|
|
end;
|
|
Dest.fConnection := TMVCActiveRecord.CurrentConnection;
|
|
Dest.fConnection.StartTransaction;
|
|
end;
|
|
|
|
class operator TMVCTransactionContext.Finalize(var Dest: TMVCTransactionContext);
|
|
begin
|
|
if Dest.fConnection <> nil then
|
|
begin
|
|
if ExceptAddr <> nil then
|
|
begin
|
|
Dest.fConnection.Rollback;
|
|
end
|
|
else
|
|
begin
|
|
Dest.fConnection.Commit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
|
|
gTableMapLock := TObject.Create;
|
|
gCtx := TRttiContext.Create;
|
|
gCtx.FindType('');
|
|
|
|
finalization
|
|
|
|
gCtx.Free;
|
|
gTableMapLock.Free;
|
|
|
|
end.
|