mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
3827 lines
110 KiB
ObjectPascal
3827 lines
110 KiB
ObjectPascal
// *************************************************************************** }
|
|
//
|
|
// Delphi MVC Framework
|
|
//
|
|
// Copyright (c) 2010-2022 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.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,
|
|
System.SysUtils,
|
|
MVCFramework,
|
|
MVCFramework.Commons,
|
|
MVCFramework.RQL.Parser,
|
|
MVCFramework.Cache,
|
|
MVCFramework.Serializer.Intf,
|
|
MVCFramework.Serializer.Commons, System.SyncObjs;
|
|
|
|
type
|
|
EMVCActiveRecord = class(EMVCException)
|
|
public
|
|
constructor Create(const AMsg: string); reintroduce; { do not override!! }
|
|
end;
|
|
|
|
EMVCActiveRecordNotFound = class(EMVCActiveRecord)
|
|
public
|
|
procedure AfterConstruction; override;
|
|
end;
|
|
|
|
TMVCActiveRecordClass = class of TMVCActiveRecord;
|
|
TMVCActiveRecord = class;
|
|
TMVCActiveRecordFieldOption = (foPrimaryKey, { it's the primary key of the mapped table }
|
|
foAutoGenerated, { not written, read - similar to readonly }
|
|
foTransient, { not written, not read }
|
|
foReadOnly, { not written, read }
|
|
foWriteOnly); { written, not read }
|
|
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
|
|
// TableName: string;
|
|
FieldName: string;
|
|
FieldOptions: TMVCActiveRecordFieldOptions;
|
|
DataTypeName: string;
|
|
Writeable, Readable: Boolean;
|
|
procedure EndUpdates;
|
|
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;
|
|
|
|
|
|
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;
|
|
|
|
TMVCActiveRecord = class
|
|
private
|
|
fChildren: TObjectList<TObject>;
|
|
fConn: TFDConnection;
|
|
fSQLGenerator: TMVCSQLGenerator;
|
|
fPrimaryKeyFieldName: string;
|
|
fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
|
|
fPrimaryKeySequenceName: string;
|
|
fPrimaryKeyFieldType: TFieldType;
|
|
fEntityAllowedActions: TMVCEntityActions;
|
|
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);
|
|
procedure SetTableName(const Value: string);
|
|
function GetAttributes(const AttrName: string): TValue;
|
|
procedure SetAttributes(const AttrName: string; const Value: TValue);
|
|
protected
|
|
fRTTIType: TRttiInstanceType;
|
|
fProps: TArray<TRTTIField>;
|
|
fObjAttributes: TArray<TCustomAttribute>;
|
|
fPropsAttributes: TArray<TCustomAttribute>;
|
|
fTableName: string;
|
|
fDefaultRQLFilter: string;
|
|
fMap: TFieldsMap;
|
|
fPrimaryKey: TRTTIField;
|
|
fBackendDriver: string;
|
|
fMapping: TMVCFieldsMapping;
|
|
fPartitionInfoInternal: TPartitionInfo;
|
|
fPartitionClause: String;
|
|
function GetPartitionInfo: TPartitionInfo;
|
|
function GetBackEnd: string;
|
|
function GetConnection: TFDConnection;
|
|
procedure InitTableInfo;
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const Unidirectional: Boolean): TDataSet; overload;
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const Connection: TFDConnection; const Unidirectional: Boolean)
|
|
: TDataSet; overload;
|
|
class function ExecQuery(const SQL: string; const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType; const Unidirectional: 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): 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;
|
|
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string; const aFieldType: TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean): T; 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;
|
|
public
|
|
constructor Create(aLazyLoadConnection: Boolean); overload;
|
|
{ cannot be virtual! }
|
|
constructor Create; overload; virtual;
|
|
destructor Destroy; override;
|
|
procedure EnsureConnection;
|
|
procedure InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
|
|
/// <summary>
|
|
/// Executes an Insert (pk is null) or an Update (pk is not null)
|
|
/// </summary>
|
|
procedure Store;
|
|
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;
|
|
// dynamic access
|
|
property Attributes[const AttrName: string]: TValue read GetAttributes write SetAttributes;
|
|
[MVCDoNotSerialize]
|
|
property TableName: string read fTableName write SetTableName;
|
|
[MVCDoNotSerialize]
|
|
property PrimaryKeyIsAutogenerated: Boolean read GetPrimaryKeyIsAutogenerated
|
|
write SetPrimaryKeyIsAutogenerated;
|
|
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 GetScalar(const SQL: string; const Params: array of Variant): Variant;
|
|
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 SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
|
|
const MaxRecordCount: Integer)
|
|
: TMVCActiveRecordList; overload;
|
|
class function DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
|
|
function SelectRQL(const RQL: string; const MaxRecordCount: Integer)
|
|
: TMVCActiveRecordList; 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 All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
|
|
overload;
|
|
class function DeleteAll(const aClass: TMVCActiveRecordClass): int64; overload;
|
|
function Count(const RQL: string = ''): int64; overload;
|
|
class function Count(const aClass: TMVCActiveRecordClass; const RQL: string = '')
|
|
: int64; overload;
|
|
class function SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const Unidirectional: Boolean = False): TDataSet; overload;
|
|
class function SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Unidirectional: Boolean = False): TDataSet; overload;
|
|
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);
|
|
|
|
IMVCMultiExecutor<T: TMVCActiveRecord> = interface
|
|
['{C815246B-19CA-4F6C-AA67-8E491F809340}']
|
|
procedure Apply(const ItemApplyAction: TMVCItemApplyAction<T> = nil);
|
|
end;
|
|
|
|
TMVCActiveRecordHelper = class helper for TMVCActiveRecord
|
|
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;
|
|
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
|
|
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;
|
|
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;
|
|
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
|
|
const MaxRecordCount: Integer)
|
|
: TObjectList<T>; overload;
|
|
class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function All<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
|
|
class function Count<T: TMVCActiveRecord>(const RQL: string = ''): int64; overload;
|
|
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 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;
|
|
class function Merge<T: TMVCActiveRecord>(CurrentList,
|
|
NewList: TObjectList<T>): IMVCMultiExecutor<T>;
|
|
end;
|
|
|
|
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>;
|
|
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>;
|
|
end;
|
|
|
|
IMVCActiveRecordConnections = interface
|
|
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
|
|
procedure AddConnection(const aName: string; const aConnection: TFDConnection;
|
|
const Owns: Boolean = false);
|
|
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: 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 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);
|
|
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 GetByName(const aName: string): TFDConnection;
|
|
function GetCurrentBackend: string;
|
|
procedure SetDefault;
|
|
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 SQL1, SQL2: 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;
|
|
// 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 TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): 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 TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
|
|
function CreateDeleteAllSQL(const TableName: string): string; virtual;
|
|
function CreateSelectCount(const TableName: string): string; virtual;
|
|
function CreateUpdateSQL(const TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): 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
|
|
cLock: TObject;
|
|
fSQLGenerators: TDictionary<string, TMVCSQLGeneratorClass>;
|
|
protected
|
|
constructor Create;
|
|
public
|
|
destructor Destroy; override;
|
|
class function Instance: TMVCSQLGeneratorRegistry;
|
|
class destructor Destroy;
|
|
class constructor Create;
|
|
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;
|
|
|
|
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
|
|
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
|
|
function GetBackEndByConnection(aConnection: TFDConnection): string;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.TypInfo,
|
|
System.IOUtils,
|
|
System.Classes,
|
|
MVCFramework.DataSet.Utils,
|
|
MVCFramework.Logger,
|
|
MVCFramework.Nullables,
|
|
MVCFramework.RTTI.Utils,
|
|
FireDAC.Stan.Option,
|
|
Data.FmtBcd, System.Variants;
|
|
|
|
var
|
|
gCtx: TRttiContext;
|
|
gEntitiesRegistry: IMVCEntitiesRegistry;
|
|
gConnections: IMVCActiveRecordConnections;
|
|
gLock: TObject;
|
|
|
|
function GetBackEndByConnection(aConnection: TFDConnection): string;
|
|
begin
|
|
case Ord(aConnection.RDBMSKind) of
|
|
0:
|
|
Exit('unknown');
|
|
1:
|
|
Exit('oracle');
|
|
2:
|
|
Exit('mssql');
|
|
3:
|
|
Exit('msaccess');
|
|
4:
|
|
Exit('mysql');
|
|
5:
|
|
Exit('db2');
|
|
6:
|
|
Exit('sqlanywhere');
|
|
7:
|
|
Exit('advantage');
|
|
8:
|
|
Exit('interbase');
|
|
9:
|
|
Exit('firebird');
|
|
10:
|
|
Exit('sqlite');
|
|
11:
|
|
Exit('postgresql');
|
|
12:
|
|
Exit('nexusdb');
|
|
13:
|
|
Exit('dataSnap');
|
|
14:
|
|
Exit('informix');
|
|
15:
|
|
Exit('teradata');
|
|
16:
|
|
Exit('mongodb');
|
|
17:
|
|
Exit('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 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.AddDefaultConnection(
|
|
const aConnectionDefName: String);
|
|
var
|
|
lConn: TFDConnection;
|
|
begin
|
|
lConn := TFDConnection.Create(nil);
|
|
try
|
|
lConn.ConnectionDefName := aConnectionDefName;
|
|
AddDefaultConnection(lConn, True);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
lConn.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
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.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;
|
|
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;
|
|
fMap.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];
|
|
//lPar.DataTypeName := fPartitionInfo.FieldValues[I];
|
|
MapTValueToParam(lValue, lPar);
|
|
end
|
|
end;
|
|
{end-partitioning}
|
|
|
|
for lPair in fMap do
|
|
begin
|
|
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
|
|
if lPar <> nil then
|
|
begin
|
|
lValue := lPair.Key.GetValue(Self);
|
|
lPar.DataTypeName := fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
|
|
MapTValueToParam(lValue, lPar);
|
|
end
|
|
end;
|
|
|
|
// check if it's the primary key
|
|
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(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(fPrimaryKey.GetValue(Self), lPar);
|
|
end;
|
|
end;
|
|
|
|
if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fPrimaryKeyOptions) and
|
|
fPrimaryKeySequenceName.IsEmpty then
|
|
begin
|
|
lValue := fPrimaryKey.GetValue(Self);
|
|
lQry.Open;
|
|
|
|
if (lValue.Kind = tkRecord) then
|
|
begin
|
|
MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fPrimaryKey, Self);
|
|
end
|
|
else
|
|
begin
|
|
lValue := lQry.FieldByName(fPrimaryKeyFieldName).AsInteger;
|
|
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): TDataSet;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, [], Connection, Unidirectional);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.FillPrimaryKey(const SequenceName: string);
|
|
var
|
|
lDS: TDataSet;
|
|
lSQL: string;
|
|
begin
|
|
if not SequenceName.IsEmpty then
|
|
begin
|
|
lSQL := SQLGenerator.GetSequenceValueSQL(fPrimaryKeyFieldName, SequenceName);
|
|
if lSQL.IsEmpty then
|
|
begin
|
|
Exit;
|
|
end;
|
|
lDS := ExecQuery(lSQL, [], True);
|
|
try
|
|
MapDataSetFieldToRTTIField(lDS.Fields[0], fPrimaryKey, Self);
|
|
finally
|
|
lDS.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant; const Unidirectional: Boolean)
|
|
: TDataSet;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, nil, Unidirectional);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.InitTableInfo;
|
|
var
|
|
lAttribute: TCustomAttribute;
|
|
lRTTIField: TRTTIField;
|
|
lFieldInfo: TFieldInfo;
|
|
lPrimaryFieldTypeAsStr: string;
|
|
begin
|
|
fPartitionInfoInternal := nil;
|
|
fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve,
|
|
TMVCEntityAction.eaUpdate,
|
|
TMVCEntityAction.eaDelete];
|
|
fTableName := '';
|
|
fPartitionClause := '';
|
|
fRTTIType := gCtx.GetType(Self.ClassInfo) as TRttiInstanceType;
|
|
fObjAttributes := fRTTIType.GetAttributes;
|
|
for lAttribute in fObjAttributes do
|
|
begin
|
|
if lAttribute is MVCTableAttribute then
|
|
begin
|
|
fTableName := MVCTableAttribute(lAttribute).Name;
|
|
fDefaultRQLFilter := MVCTableAttribute(lAttribute).RQLFilter;
|
|
Continue;
|
|
end;
|
|
if lAttribute is MVCEntityActionsAttribute then
|
|
begin
|
|
fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions;
|
|
end;
|
|
if lAttribute is MVCPartitionAttribute then
|
|
begin
|
|
fPartitionClause := MVCPartitionAttribute(lAttribute).PartitionClause;
|
|
Continue;
|
|
end;
|
|
end;
|
|
|
|
if fTableName = '' then
|
|
begin
|
|
if [eaCreate, eaUpdate, eaDelete] * fEntityAllowedActions <> [] then
|
|
begin
|
|
raise Exception.Create('Cannot find TableNameAttribute');
|
|
end;
|
|
end;
|
|
|
|
fProps := fRTTIType.GetFields;
|
|
for lRTTIField in fProps do
|
|
begin
|
|
fPropsAttributes := lRTTIField.GetAttributes;
|
|
if Length(fPropsAttributes) = 0 then
|
|
continue;
|
|
for lAttribute in fPropsAttributes do
|
|
begin
|
|
if lAttribute is MVCTableFieldAttribute then
|
|
begin
|
|
if foPrimaryKey in MVCTableFieldAttribute(lAttribute).FieldOptions then
|
|
begin
|
|
fPrimaryKey := lRTTIField;
|
|
lPrimaryFieldTypeAsStr := fPrimaryKey.FieldType.ToString.ToLower;
|
|
if lPrimaryFieldTypeAsStr.EndsWith('int64') then
|
|
begin
|
|
fPrimaryKeyFieldType := ftLargeInt;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('integer') or
|
|
lPrimaryFieldTypeAsStr.EndsWith('int32') then
|
|
begin
|
|
fPrimaryKeyFieldType := ftInteger;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('string') then
|
|
begin
|
|
fPrimaryKeyFieldType := ftString;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('guid') then
|
|
begin
|
|
fPrimaryKeyFieldType := ftGuid;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create
|
|
('Allowed primary key types are: (Nullable)Integer, (Nullable)Int64, (Nullable)String, GUID - found: '
|
|
+
|
|
lPrimaryFieldTypeAsStr);
|
|
end;
|
|
fPrimaryKeyFieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
fPrimaryKeyOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
|
|
fPrimaryKeySequenceName := MVCTableFieldAttribute(lAttribute).SequenceName;
|
|
continue;
|
|
end;
|
|
|
|
lFieldInfo := TFieldInfo.Create;
|
|
// lFieldInfo.TableName := fTableName;
|
|
lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
lFieldInfo.FieldOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
|
|
lFieldInfo.DataTypeName := MVCTableFieldAttribute(lAttribute).DataTypeName;
|
|
|
|
fMap.Add(lRTTIField, lFieldInfo);
|
|
|
|
// if not(foTransient in MVCTableFieldAttribute(lAttribute).FieldOptions) then
|
|
// begin
|
|
// lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
// fMapNonTransientFields.Add(lRTTIField, lFieldInfo);
|
|
// end;
|
|
//
|
|
// if not MVCTableFieldAttribute(lAttribute).DataTypeName.IsEmpty then
|
|
// begin
|
|
// fMapFieldDataTypes.Add(MVCTableFieldAttribute(lAttribute).FieldName.ToUpper,
|
|
// MVCTableFieldAttribute(lAttribute).DataTypeName);
|
|
// end;
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
fMap.EndUpdates;
|
|
Assert(fMap.WritableFieldsCount + fMap.ReadableFieldsCount > 0,
|
|
'No fields defined [HINT] Use MVCTableField in private fields');
|
|
fPartitionInfoInternal := nil;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Insert;
|
|
var
|
|
SQL: string;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaCreate);
|
|
OnValidation(TMVCEntityAction.eaCreate);
|
|
OnBeforeInsert;
|
|
OnBeforeInsertOrUpdate;
|
|
if fMap.WritableFieldsCount = 0 then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Cannot insert an entity if all fields are not writable or transient. Class [%s] mapped on table [%s]',
|
|
[ClassName, fTableName]);
|
|
end;
|
|
if (foAutoGenerated in fPrimaryKeyOptions) 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 fPrimaryKeySequenceName.IsEmpty then
|
|
begin
|
|
raise EMVCActiveRecord.Create('SequenceName is empty for entity ' + ClassName + ' but ' +
|
|
GetBackEnd +
|
|
' requires it');
|
|
end;
|
|
if foReadOnly in fPrimaryKeyOptions then
|
|
begin
|
|
raise EMVCActiveRecord.Create('Cannot define a read-only primary key when a sequence is used for the class ' + ClassName);
|
|
end;
|
|
FillPrimaryKey(fPrimaryKeySequenceName);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
SQL := SQLGenerator.CreateInsertSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
ExecNonQuery(SQL, True);
|
|
OnAfterInsert;
|
|
OnAfterInsertOrUpdate;
|
|
end;
|
|
|
|
function TMVCActiveRecord.InternalCount(const RQL: string): int64;
|
|
var
|
|
lSQL: string;
|
|
begin
|
|
lSQL := Self.SQLGenerator.CreateSelectCount(fTableName);
|
|
lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false, True);
|
|
Result := GetScalar(lSQL, []);
|
|
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;
|
|
SetLength(fMapping, 0);
|
|
{ TODO -oDanieleT -cGeneral : Consider lazyconnection }
|
|
if not aLazyLoadConnection then
|
|
begin
|
|
GetConnection;
|
|
end;
|
|
fMap := TFieldsMap.Create;
|
|
// fMapNonTransientFields := TFieldsMap.Create;
|
|
// fMapFieldDataTypes := TDictionary<string, string>.Create;
|
|
InitTableInfo;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GenerateSelectSQL: string;
|
|
begin
|
|
Result := SQLGenerator.CreateSelectSQL(fTableName, fMap, fPrimaryKeyFieldName,
|
|
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;
|
|
begin
|
|
Result := aActiveRecord;
|
|
try
|
|
if not Result.LoadByPK(aValue, aFieldType) then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('No data found')
|
|
else
|
|
FreeAndNil(Result);
|
|
end;
|
|
except
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.GetByPK<T>(const aValue: string; const aFieldType: TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := T(GetByPK(T.Create, aValue, aFieldType, RaiseExceptionIfNotFound));
|
|
end;
|
|
|
|
class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
|
|
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
|
|
begin
|
|
Result := GetByPK(aClass.Create, aValue, ftString, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
|
|
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
|
|
begin
|
|
Result := GetByPK(aClass.Create, aValue.ToString, ftInteger, RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecord.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.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;
|
|
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(fMapping) = 0 then
|
|
begin
|
|
if not fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
SetLength(fMapping, fMap.Count + 1);
|
|
fMapping[0].InstanceFieldName := fPrimaryKey.Name.Substring(1).ToLower;
|
|
fMapping[0].DatabaseFieldName := fPrimaryKeyFieldName;
|
|
i := 1;
|
|
end
|
|
else
|
|
begin
|
|
SetLength(fMapping, fMap.Count);
|
|
i := 0;
|
|
end;
|
|
|
|
for lPair in fMap do
|
|
begin
|
|
fMapping[i].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
|
|
fMapping[i].DatabaseFieldName := lPair.Value.FieldName;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
Result := 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;
|
|
|
|
function TMVCActiveRecord.GetPartitionInfo: TPartitionInfo;
|
|
var
|
|
lRQLCompilerClass: TRQLCompilerClass;
|
|
begin
|
|
if fPartitionInfoInternal = nil then
|
|
begin
|
|
lRQLCompilerClass := TRQLCompilerRegistry.Instance.GetCompiler(GetBackEnd);
|
|
fPartitionInfoInternal := TPartitionInfo.BuildPartitionClause(fPartitionClause, lRQLCompilerClass);
|
|
end;
|
|
Result := 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 := fPrimaryKeyFieldType;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetPrimaryKeyIsAutogenerated: Boolean;
|
|
begin
|
|
Result := foAutoGenerated in fPrimaryKeyOptions;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.GetScalar(const SQL: string;
|
|
const Params: array of Variant): Variant;
|
|
begin
|
|
Result := CurrentConnection.ExecSQLScalar(SQL, Params);
|
|
end;
|
|
|
|
function TMVCActiveRecord.CheckAction(const aEntityAction: TMVCEntityAction;
|
|
const aRaiseException: Boolean): Boolean;
|
|
begin
|
|
Result := aEntityAction in fEntityAllowedActions;
|
|
if (not Result) and aRaiseException then
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Action [%s] not allowed on entity [%s]. [HINT] Add the entity action in MVCEntityActions attribute.',
|
|
[GetEnumName(TypeInfo(TMVCEntityAction), Ord(aEntityAction)), ClassName]);
|
|
end;
|
|
|
|
class function TMVCActiveRecord.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 TMVCActiveRecord.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 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;
|
|
|
|
constructor TMVCActiveRecord.Create;
|
|
begin
|
|
Create(True);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Delete(const RaiseExceptionIfNotFound: Boolean);
|
|
var
|
|
SQL: string;
|
|
lAffectedRows: Int64;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaDelete);
|
|
OnValidation(TMVCEntityAction.eaDelete);
|
|
OnBeforeDelete;
|
|
if not Assigned(fPrimaryKey) then
|
|
raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
|
|
SQL := SQLGenerator.CreateDeleteSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
lAffectedRows := ExecNonQuery(SQL, false);
|
|
if (lAffectedRows = 0) and RaiseExceptionIfNotFound then
|
|
begin
|
|
raise EMVCActiveRecordNotFound.CreateFmt('No record deleted for key [Entity: %s][PK: %s]',
|
|
[ClassName, fPrimaryKeyFieldName]);
|
|
end;
|
|
OnAfterDelete;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.DeleteAll(const aClass: TMVCActiveRecordClass): int64;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
Result := lAR.ExecNonQuery(
|
|
lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableName) +
|
|
lAR.SQLGenerator.GetDefaultSQLFilter(True)
|
|
);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.DeleteRQL(const aClass: TMVCActiveRecordClass;
|
|
const RQL: string): int64;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create(True);
|
|
try
|
|
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.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;
|
|
begin
|
|
Assert(aValue.Kind = tkRecord);
|
|
Result := false;
|
|
if aValue.IsType(TypeInfo(NullableString)) then
|
|
begin
|
|
if not aValue.AsType<NullableString>().HasValue then
|
|
begin
|
|
aParam.DataType := ftString;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableString>().Value;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableInt32)) then
|
|
begin
|
|
if not aValue.AsType<NullableInt32>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableInt32>().Value;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableTDate)) then
|
|
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);
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableTTime)) then
|
|
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);
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableTDateTime)) then
|
|
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);
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableUInt32)) then
|
|
begin
|
|
if not aValue.AsType<NullableUInt32>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableUInt32>().Value;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableInt64)) then
|
|
begin
|
|
if not aValue.AsType<NullableInt64>().HasValue then
|
|
begin
|
|
aParam.DataType := ftLargeInt;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableInt64>().Value;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableInt16)) then
|
|
begin
|
|
if not aValue.AsType<NullableInt16>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableInt16>().Value;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableUInt64)) then
|
|
begin
|
|
if not aValue.AsType<NullableUInt64>().HasValue then
|
|
begin
|
|
aParam.DataType := ftLargeInt;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableUInt64>().Value;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableUInt16)) then
|
|
begin
|
|
if not aValue.AsType<NullableUInt16>().HasValue then
|
|
begin
|
|
aParam.DataType := ftInteger;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := aValue.AsType<NullableUInt16>().Value;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableBoolean)) then
|
|
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);
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableSingle)) then
|
|
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;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableDouble)) then
|
|
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;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableCurrency)) then
|
|
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;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableTGUID)) then
|
|
begin
|
|
if not aValue.AsType<NullableTGUID>().HasValue then
|
|
begin
|
|
aParam.DataType := TFieldType.ftCurrency;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TGUID>(aValue.AsType<NullableTGUID>().Value);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
if Result then
|
|
begin
|
|
MapTValueToParam(aValue, aParam);
|
|
end;
|
|
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
|
|
aParam.AsBoolean := aValue.AsBoolean;
|
|
end
|
|
else
|
|
begin
|
|
aParam.AsInteger := Ord(aValue.AsInteger);
|
|
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.IsType(TypeInfo(TGUID)) then
|
|
begin
|
|
aParam.AsGuid := aValue.AsType<TGUID>;
|
|
end
|
|
else if aValue.IsType(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 fMap do
|
|
begin
|
|
if not lItem.Value.Readable 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 fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
MapDataSetFieldToRTTIField(aDataSet.FieldByName(fPrimaryKeyFieldName), 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(fTableName, fMap, fPrimaryKeyFieldName,
|
|
fPrimaryKeyOptions);
|
|
lDataSet := ExecQuery(SQL, [id], [aFieldType], GetConnection, True);
|
|
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.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 TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant): TMVCActiveRecordList;
|
|
begin
|
|
Result := Select(aClass, SQL, Params, nil);
|
|
end;
|
|
|
|
class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
|
|
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
|
|
var
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
Result := TMVCActiveRecordList.Create;
|
|
try
|
|
lDataSet := ExecQuery(SQL, Params, Connection, True);
|
|
try
|
|
while not lDataSet.Eof do
|
|
begin
|
|
lAR := aClass.Create;
|
|
Result.Add(lAR);
|
|
lAR.LoadByDataset(lDataSet);
|
|
lDataSet.Next;
|
|
end;
|
|
finally
|
|
lDataSet.Free;
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
|
|
end;
|
|
|
|
class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const Unidirectional: Boolean): TDataSet;
|
|
begin
|
|
Result := TMVCActiveRecord.ExecQuery(SQL, Params, ParamTypes, Unidirectional);
|
|
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 TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const Unidirectional: Boolean)
|
|
: TDataSet;
|
|
begin
|
|
{TODO -odanielet -cGeneral : gestire unidirectional}
|
|
Result := TMVCActiveRecord.ExecQuery(SQL, Params, Unidirectional);
|
|
end;
|
|
|
|
function TMVCActiveRecord.SelectRQL(const RQL: string; const MaxRecordCount: Integer)
|
|
: TMVCActiveRecordList;
|
|
begin
|
|
Result := InternalSelectRQL(RQL, MaxRecordCount);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions)
|
|
: TObjectList<T>;
|
|
var
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
lHandled: Boolean;
|
|
begin
|
|
Result := TObjectList<T>.Create(True);
|
|
try
|
|
lDataSet := ExecQuery(SQL, Params, ParamTypes, False);
|
|
try
|
|
while not lDataSet.Eof do
|
|
begin
|
|
lAR := T.Create;
|
|
Result.Add(lAR);
|
|
lAR.LoadByDataset(lDataSet, Options);
|
|
lDataSet.Next;
|
|
end;
|
|
finally
|
|
lDataSet.Free;
|
|
end;
|
|
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
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
lHandled: Boolean;
|
|
lList: TObjectList<T>;
|
|
begin
|
|
Result := nil;
|
|
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>;
|
|
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)
|
|
end
|
|
else
|
|
begin
|
|
if lFilter.IsEmpty then
|
|
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes)
|
|
else
|
|
begin
|
|
Result := Select<T>(lAR.GenerateSelectSQL + lFilter + ' AND ' + SQLWhere, Params, ParamTypes);
|
|
end;
|
|
end;
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.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 fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
raise Exception.Create('No primary key defined');
|
|
end;
|
|
|
|
if fPrimaryKey.GetValue(Self).Kind = tkRecord then
|
|
begin
|
|
lPKValue := fPrimaryKey.GetValue(Self);
|
|
if lPKValue.IsType<NullableInt32> and aValue.IsType<NullableInt32>() then
|
|
begin
|
|
if aValue.IsType<UInt32> then
|
|
begin
|
|
lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
|
|
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;
|
|
fPrimaryKey.SetValue(Self, lPKValue);
|
|
end
|
|
else
|
|
begin
|
|
fPrimaryKey.SetValue(Self, aValue)
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetPrimaryKeyIsAutogenerated(const Value: Boolean);
|
|
begin
|
|
if Value then
|
|
begin
|
|
Include(fPrimaryKeyOptions, foAutoGenerated);
|
|
end
|
|
else
|
|
begin
|
|
Exclude(fPrimaryKeyOptions, foAutoGenerated);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetTableName(const Value: string);
|
|
begin
|
|
fTableName := Value;
|
|
end;
|
|
|
|
function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator;
|
|
begin
|
|
if not Assigned(fSQLGenerator) then
|
|
begin
|
|
GetConnection.Connected := True;
|
|
fSQLGenerator := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd)
|
|
.Create(GetMapping, 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: ' + fTableName;
|
|
for KeyValue in 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 fPrimaryKeyFieldName.IsEmpty then
|
|
raise Exception.Create('No primary key defined');
|
|
Value := fPrimaryKey.GetValue(Self);
|
|
if Value.Kind = tkRecord then
|
|
begin
|
|
if Value.IsType<NullableInt32>() then
|
|
begin
|
|
Result := Value.AsType<NullableInt32>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableInt32>().Value;
|
|
end
|
|
else if Value.IsType<NullableInt64>() then
|
|
begin
|
|
Result := Value.AsType<NullableInt64>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableInt64>().Value;
|
|
end
|
|
else if Value.IsType<NullableUInt32>() then
|
|
begin
|
|
Result := Value.AsType<NullableUInt32>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableUInt32>().Value;
|
|
end
|
|
else if Value.IsType<NullableUInt64>() then
|
|
begin
|
|
Result := Value.AsType<NullableUInt64>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableUInt64>().Value;
|
|
end
|
|
else if Value.IsType<NullableInt16>() then
|
|
begin
|
|
Result := Value.AsType<NullableInt16>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableInt16>().Value;
|
|
end
|
|
else if Value.IsType<NullableUInt16>() then
|
|
begin
|
|
Result := Value.AsType<NullableUInt16>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableUInt16>().Value;
|
|
end
|
|
else if Value.IsType<NullableString>() then
|
|
begin
|
|
Result := Value.AsType<NullableString>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableString>().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 fMap.WritableFieldsCount = 0 then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Cannot update an entity if all fields are transient. Class [%s] mapped on table [%s]',
|
|
[ClassName, fTableName]);
|
|
end;
|
|
SQL := SQLGenerator.CreateUpdateSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
lAffectedRows := ExecNonQuery(SQL, false);
|
|
if (lAffectedRows = 0) and RaiseExceptionIfNotFound then
|
|
begin
|
|
raise EMVCActiveRecordNotFound.CreateFmt('No record updated for key [Entity: %s][PK: %s]',
|
|
[ClassName, fPrimaryKeyFieldName]);
|
|
end;
|
|
OnAfterUpdate;
|
|
OnAfterInsertOrUpdate;
|
|
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 TMVCActiveRecord.All(const aClass: TMVCActiveRecordClass)
|
|
: TObjectList<TMVCActiveRecord>;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
Result := Select(aClass, lAR.GenerateSelectSQL, []);
|
|
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, []);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
|
|
const Params: array of Variant): TMVCActiveRecordList;
|
|
begin
|
|
Result := Where(aClass, SQLWhere, Params, nil);
|
|
end;
|
|
|
|
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
|
|
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection);
|
|
finally
|
|
lAR.Free;
|
|
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>)
|
|
: IMVCMultiExecutor<T>;
|
|
var
|
|
i: Integer;
|
|
lFoundAtIndex: Integer;
|
|
lCurrPKValue: Integer;
|
|
lPKValue: TValue;
|
|
lUnitOfWork: IMVCUnitOfWork<T>;
|
|
lPKType: TFieldType;
|
|
lNeedsToBeUpdated: Boolean;
|
|
begin
|
|
lUnitOfWork := TMVCUnitOfWork<T>.Create;
|
|
lUnitOfWork.RegisterDelete(CurrentList);
|
|
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
|
|
lUnitOfWork.RegisterInsert(NewList[i]);
|
|
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');
|
|
end;
|
|
|
|
if lNeedsToBeUpdated then
|
|
lUnitOfWork.RegisterUpdate(NewList[i])
|
|
else
|
|
lUnitOfWork.RegisterInsert(NewList[i]);
|
|
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;
|
|
|
|
{ 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
|
|
cLock := TObject.Create;
|
|
end;
|
|
|
|
class destructor TMVCSQLGeneratorRegistry.Destroy;
|
|
begin
|
|
cLock.Free;
|
|
cInstance.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"', [aBackend]);
|
|
end;
|
|
end;
|
|
|
|
class function TMVCSQLGeneratorRegistry.Instance: TMVCSQLGeneratorRegistry;
|
|
begin
|
|
if not Assigned(cInstance) then
|
|
begin
|
|
TMonitor.Enter(cLock);
|
|
try
|
|
if not Assigned(cInstance) then
|
|
begin
|
|
cInstance := TMVCSQLGeneratorRegistry.Create;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(cLock);
|
|
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 TableName: string;
|
|
const Map: TFieldsMap; const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): string;
|
|
begin
|
|
Result := CreateDeleteAllSQL(TableName) + ' WHERE ' + GetFieldNameForSQL(PKFieldName) + '=:' +
|
|
GetParamNameForSQL(PKFieldName);
|
|
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 TableName: string;
|
|
const Map: TFieldsMap; const PKFieldName: string;
|
|
const PKOptions: TMVCActiveRecordFieldOptions): string;
|
|
var
|
|
lPair: TPair<TRttiField, TFieldInfo>;
|
|
I: Integer;
|
|
begin
|
|
Result := 'UPDATE ' + GetTableNameForSQL(TableName) + ' SET ';
|
|
for lPair in Map do
|
|
begin
|
|
if lPair.Value.Writeable 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 PKFieldName.IsEmpty then
|
|
begin
|
|
Result := Result + ' where ' + GetFieldNameForSQL(PKFieldName) + '= :' + GetParamNameForSQL(PKFieldName);
|
|
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.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;
|
|
|
|
|
|
//
|
|
// var Pieces := RQL.Split([';']);
|
|
// if Pieces[0].Trim.Length > 0 then
|
|
// begin
|
|
// Result := 'and('+fDefaultRQLFilter + ',' + Pieces[0] + ');' + string.Join(';', Pieces, 1, Length(Pieces)-1);
|
|
// end
|
|
// else
|
|
// begin
|
|
// Result := fDefaultRQLFilter + ';' + string.Join(';', Pieces, 1, Length(Pieces)-1);
|
|
// end;
|
|
// end
|
|
//
|
|
//
|
|
//
|
|
// if not fDefaultRQLFilter.IsEmpty then
|
|
// begin
|
|
// if RQL.Contains(';') then
|
|
// begin
|
|
// var Pieces := RQL.Split([';']);
|
|
// if Pieces[0].Trim.Length > 0 then
|
|
// begin
|
|
// Result := 'and('+fDefaultRQLFilter + ',' + Pieces[0] + ');' + string.Join(';', Pieces, 1, Length(Pieces)-1);
|
|
// end
|
|
// else
|
|
// begin
|
|
// Result := fDefaultRQLFilter + ';' + string.Join(';', Pieces, 1, Length(Pieces)-1);
|
|
// end;
|
|
// end
|
|
// else
|
|
// begin
|
|
// if RQL.IsEmpty then
|
|
// begin
|
|
// Result := fDefaultRQLFilter
|
|
// end
|
|
// else
|
|
// begin
|
|
// Result := MergeRQL(Result, fPartitionInfo.RQLFilter);
|
|
// end;
|
|
// //Result := 'and('+fDefaultRQLFilter + ',' + RQL + ')';
|
|
// end;
|
|
// end
|
|
// else
|
|
// begin
|
|
// Result := RQL;
|
|
// end;
|
|
// Result := MergeRQL(Result, fPartitionInfo.RQLFilter);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.MergeSQLFilter(const SQL1, SQL2: String): String;
|
|
begin
|
|
if SQL1 + SQL2 = '' then
|
|
begin
|
|
Exit('');
|
|
end;
|
|
if SQL1.IsEmpty and (not SQL2.IsEmpty) then
|
|
begin
|
|
Exit(SQL2);
|
|
end;
|
|
if SQL2.IsEmpty and (not SQL1.IsEmpty) then
|
|
begin
|
|
Exit(SQL1);
|
|
end;
|
|
Result := '((' + SQL1 + ') and (' + SQL2 + '))';
|
|
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 not lPair.Value.FieldName.IsEmpty then
|
|
if lPair.Value.Readable 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;
|
|
fHttpErrorCode := 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): TDataSet;
|
|
var
|
|
lQry: TFDQuery;
|
|
begin
|
|
lQry := TFDQuery.Create(nil);
|
|
try
|
|
lQry.FetchOptions.Unidirectional := Unidirectional; // True;
|
|
lQry.UpdateOptions.ReadOnly := True;
|
|
if Connection = nil then
|
|
begin
|
|
lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
end
|
|
else
|
|
begin
|
|
lQry.Connection := Connection;
|
|
end;
|
|
lQry.SQL.Text := SQL;
|
|
// lQry.Prepare;
|
|
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): TDataSet;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional);
|
|
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 not(foTransient in lPair.Value.FieldOptions) then
|
|
if lPair.Value.Writeable then
|
|
begin
|
|
Inc(fWritableFieldsCount);
|
|
end;
|
|
if lPair.Value.Readable 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
|
|
Writeable := false;
|
|
Readable := false;
|
|
end
|
|
else
|
|
begin
|
|
// Writeable := (not (foReadOnly in FieldOptions)) and (not((foAutoGenerated in FieldOptions) or (foTransient in FieldOptions)));
|
|
Writeable := ((FieldOptions * [foReadOnly, foTransient, foAutoGenerated]) = []);
|
|
// Readable := (not (foWriteOnly in FieldOptions)) and (not(foTransient in FieldOptions));
|
|
Readable := (FieldOptions * [foWriteOnly, foTransient]) = [];
|
|
end;
|
|
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;
|
|
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
|
|
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] Paritioning 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;
|
|
end;
|
|
end;
|
|
|
|
class constructor TPartitionInfo.Create;
|
|
begin
|
|
PartitionInfoCache := TMVCThreadedObjectCache<TPartitionInfo>.Create;
|
|
end;
|
|
|
|
initialization
|
|
|
|
gLock := TObject.Create;
|
|
gCtx := TRttiContext.Create;
|
|
gCtx.FindType('');
|
|
|
|
finalization
|
|
|
|
gCtx.Free;
|
|
gLock.Free;
|
|
|
|
end.
|