// *************************************************************************** } // // Delphi MVC Framework // // Copyright (c) 2010-2020 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.Serializer.Intf, MVCFramework.Serializer.Commons; 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; TMVCActiveRecordFieldOption = (foPrimaryKey, foAutoGenerated, foTransient); TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption; TMVCEntityAction = (eaCreate, eaRetrieve, eaUpdate, eaDelete); TMVCEntityActions = set of TMVCEntityAction; TMVCActiveRecordLoadOption = (loIgnoreNotExistentFields); TMVCActiveRecordLoadOptions = set of TMVCActiveRecordLoadOption; 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; MVCActiveRecordCustomAttribute = class(TCustomAttribute) end; MVCTableAttribute = class(MVCActiveRecordCustomAttribute) public Name: string; constructor Create(aName: string); end; MVCTableFieldAttribute = class(MVCActiveRecordCustomAttribute) public FieldName: string; FieldOptions: TMVCActiveRecordFieldOptions; SequenceName: string; constructor Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions; const aSequenceName: String = ''); overload; constructor Create(aFieldName: string); overload; end; MVCPrimaryKeyAttribute = MVCTableFieldAttribute deprecated '(ERROR) Use MVCTableFieldAttribute'; MVCEntityActionsAttribute = class(MVCActiveRecordCustomAttribute) private EntityAllowedActions: TMVCEntityActions; public constructor Create(const aEntityAllowedActions: TMVCEntityActions); end; TMVCActiveRecord = class; TMVCSQLGenerator = class; TMVCActiveRecordList = class(TObjectList) public constructor Create; virtual; end; TMVCActiveRecord = class private fConn: TFDConnection; fSQLGenerator: TMVCSQLGenerator; fPrimaryKeyFieldName: string; fPrimaryKeyOptions: TMVCActiveRecordFieldOptions; fPrimaryKeySequenceName: String; 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); protected fRTTIType: TRttiInstanceType; fProps: TArray; fObjAttributes: TArray; fPropsAttributes: TArray; fTableName: string; fMap: TDictionary; fMapNonTransientFields: TDictionary; fPrimaryKey: TRttiField; fBackendDriver: string; fMapping: TMVCFieldsMapping; function GetBackEnd: string; function GetConnection: TFDConnection; procedure InitTableInfo; class function ExecQuery(const SQL: string; const Values: array of Variant): TDataSet; overload; class function ExecQuery(const SQL: string; const Values: array of Variant; const Connection: TFDConnection) : TDataSet; overload; procedure FillPrimaryKey(const SequenceName: String); function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64; overload; // load events /// /// Called everywhere before persist object into database /// procedure OnValidation; virtual; /// /// Called just after load the object state from database /// procedure OnAfterLoad; virtual; /// /// Called before load the object state from database /// procedure OnBeforeLoad; virtual; /// /// Called before insert the object state to database /// procedure OnBeforeInsert; virtual; /// /// Called after insert the object state to database /// procedure OnAfterInsert; virtual; /// /// Called before update the object state to database /// procedure OnBeforeUpdate; virtual; /// /// Called after update the object state to database /// procedure OnAfterUpdate; virtual; /// /// Called before delete object from database /// procedure OnBeforeDelete; virtual; /// /// Called after delete object from database /// procedure OnAfterDelete; virtual; /// /// Called before insert or update the object to the database /// procedure OnBeforeInsertOrUpdate; virtual; /// /// Called before execute sql /// procedure OnBeforeExecuteSQL(var SQL: String); virtual; /// /// Called after insert or update the object to the database /// 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; /// /// Executes an Insert or an Update if primary key is defined or not /// procedure Store; function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean; procedure Insert; function GetMapping: TMVCFieldsMapping; function LoadByPK(id: int64): Boolean; virtual; procedure Update; procedure Delete; function TableInfo: string; procedure LoadByDataset(const aDataSet: TDataSet; const aOptions: TMVCActiveRecordLoadOptions = []); procedure SetPK(const aValue: TValue); function GetPK: TValue; function TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean; [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 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; 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): TDataSet; class function CurrentConnection: TFDConnection; end; TMVCActiveRecordHelper = class helper for TMVCActiveRecord class function GetByPK(const aValue: int64; const RaiseExceptionIfNotFound: Boolean = True): T; overload; class function Select(const SQL: string; const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions = []): TObjectList; overload; class function SelectRQL(const RQL: string; const MaxRecordCount: Integer) : TObjectList; overload; class function All: TObjectList; overload; class function Count(const RQL: String = ''): int64; overload; class function Where(const SQLWhere: string; const Params: array of Variant) : TObjectList; overload; class function GetOneByWhere(const SQLWhere: string; const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T; class function GetFirstByWhere(const SQLWhere: string; const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): 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; end; TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry) private fEntitiesDict: TDictionary; fProcessorsDict: TDictionary; 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; 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); procedure RemoveConnection(const aName: string); procedure RemoveDefaultConnection; procedure SetCurrent(const aName: string); function GetCurrent: TFDConnection; function GetCurrentBackend: string; end; TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnections) private type TConnHolder = class public Connection: TFDConnection; OwnsConnection: Boolean; destructor Destroy; override; end; var fMREW: TMultiReadExclusiveWriteSynchronizer; fConnectionsDict: TDictionary; fCurrentConnectionsByThread: TDictionary; 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); procedure RemoveConnection(const aName: string); procedure RemoveDefaultConnection; procedure SetCurrent(const aName: string); function GetCurrent: TFDConnection; function GetByName(const aName: string): TFDConnection; function GetCurrentBackend: string; end; TMVCSQLGenerator = class abstract private fMapping: TMVCFieldsMapping; fCompiler: TRQLCompiler; fRQL2SQL: TRQL2SQL; protected function GetRQLParser: TRQL2SQL; function GetCompiler: TRQLCompiler; function GetCompilerClass: TRQLCompilerClass; virtual; abstract; function GetMapping: TMVCFieldsMapping; function TableFieldsDelimited(const Map: TDictionary; const PKFieldName: string; const Delimiter: string): string; public constructor Create(Mapping: TMVCFieldsMapping); virtual; destructor Destroy; override; // capabilities function HasSequences: Boolean; virtual; function HasReturning: Boolean; virtual; // end-capabilities function CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping; const UseArtificialLimit: Boolean = True): string; virtual; abstract; function CreateSelectSQL(const TableName: string; const Map: TDictionary; const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract; function CreateSelectByPKSQL(const TableName: string; const Map: TDictionary; const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions; const PrimaryKeyValue: int64): string; virtual; abstract; function CreateInsertSQL(const TableName: string; const Map: TDictionary; const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract; function CreateUpdateSQL(const TableName: string; const Map: TDictionary; const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract; function CreateDeleteSQL(const TableName: string; const Map: TDictionary; const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions; const PrimaryKeyValue: int64): string; virtual; abstract; function CreateDeleteAllSQL(const TableName: string): string; virtual; abstract; function CreateSelectCount(const TableName: String): String; virtual; abstract; function GetSequenceValueSQL( const PKFieldName: String; const SequenceName: String; const Step: Integer = 1): String; virtual; end; TMVCSQLGeneratorClass = class of TMVCSQLGenerator; TMVCSQLGeneratorRegistry = class sealed private class var cInstance: TMVCSQLGeneratorRegistry; class var cLock: TObject; fSQLGenerators: TDictionary; 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; 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, 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); 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; constructor TMVCConnectionsRepository.Create; begin inherited; fMREW := TMultiReadExclusiveWriteSynchronizer.Create; fConnectionsDict := TDictionary.Create; fCurrentConnectionsByThread := TDictionary.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: 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 raise EMVCActiveRecord.Create('No current connection for thread'); 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); var lName: string; lKeyName: string; lConnHolder: TConnHolder; begin lName := aName.ToLower; lKeyName := GetKeyName(lName); fMREW.BeginWrite; try if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then raise Exception.CreateFmt('Unknown connection %s', [aName]); 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; begin RemoveConnection('default'); 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; 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); begin Create(aFieldName, []); end; { TableAttribute } constructor MVCTableAttribute.Create(aName: string); begin inherited Create; name := aName; end; { TActiveRecord } destructor TMVCActiveRecord.Destroy; begin fMap.Free; fMapNonTransientFields.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; lValue: TValue; lSQL: String; lHandled: Boolean; begin 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 for lPair in fMap do begin lPar := lQry.FindParam(lPair.Value); if lPar <> nil then begin lValue := lPair.Key.GetValue(Self); MapTValueToParam(lValue, lPar); end end; // check if it's the primary key lPar := lQry.FindParam(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 := ftLargeint; 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); // if SameText(lValue.TypeInfo.Name, 'Nullable') then // begin // lInteger :=lQry.FieldByName(fPrimaryKeyFieldName).AsInteger; // TValue.MakeWithoutCopy(@lInteger, TypeInfo(NullableInteger), lValue); // //lValue := TValue.From(Nullable(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger)) // // if lValue.IsType then // // lValue := TValue.From(NullableInt32(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger)) // end // else if SameText(lValue.TypeInfo.Name, 'Nullable') then // begin /// / lLargeInt :=lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt; /// / TValue.MakeWithoutCopy(@lLargeInt, TypeInfo(NullableInt64), lValue); // lNullableInt64.Value := lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt; /// / fPrimaryKey.SetValue(Self, TValue.From>(lNullableInt64)); // TValue.Make(@lNullableInt64, TypeInfo(NullableInt64), lOutValue); // fPrimaryKey.SetValue(Self,3); // //fPrimaryKey.SetValue(Self,lOutValue); // /// / TValue.MakeWithoutCopy(@lNullableInt64, TypeInfo(NullableInt64), lValue); // //lValue := TValue.From(lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt) // // else if lValue.IsType then // // lValue := TValue.From(NullableInt64(lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt)) // end // else if SameText(lValue.TypeInfo.Name, 'Nullable') then // lValue := lQry.FieldByName(fPrimaryKeyFieldName).AsInteger /// / else if lValue.IsType then /// / lValue := TValue.From(NullableUInt32(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger)) // else if lValue.IsType then // lValue := TValue.From(NullableUInt64(lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt)) // else if lValue.IsType then // lValue := TValue.From(NullableInt16(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger)) // else if lValue.IsType then // lValue := TValue.From(NullableUInt16(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger)) // else // raise EMVCActiveRecord.Create('Invalid type for primary key'); 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): TDataSet; var lQry: TFDQuery; begin lQry := TFDQuery.Create(nil); try lQry.FetchOptions.Unidirectional := false; // True; if Connection = nil then begin lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent; end else begin lQry.Connection := Connection; end; lQry.SQL.Text := SQL; // lQry.Prepare; lQry.Open(SQL, Values); Result := lQry; except lQry.Free; raise; end; 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, []); 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): TDataSet; begin Result := ExecQuery(SQL, Values, nil); end; procedure TMVCActiveRecord.InitTableInfo; var lAttribute: TCustomAttribute; lRTTIField: TRttiField; begin fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve, TMVCEntityAction.eaUpdate, TMVCEntityAction.eaDelete]; fTableName := ''; 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; continue; end; if lAttribute is MVCEntityActionsAttribute then begin fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions; Break; end; end; if fTableName = '' then raise Exception.Create('Cannot find TableNameAttribute'); 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; fPrimaryKeyFieldName := MVCTableFieldAttribute(lAttribute).FieldName; fPrimaryKeyOptions := MVCTableFieldAttribute(lAttribute).FieldOptions; fPrimaryKeySequenceName := MVCTableFieldAttribute(lAttribute).SequenceName; continue; end; fMap.Add(lRTTIField, { fTableName + '.' + } MVCTableFieldAttribute(lAttribute).FieldName); if not(foTransient in MVCTableFieldAttribute(lAttribute).FieldOptions) then fMapNonTransientFields.Add(lRTTIField, MVCTableFieldAttribute(lAttribute).FieldName); end; end; end; end; procedure TMVCActiveRecord.Insert; var SQL: string; begin CheckAction(TMVCEntityAction.eaCreate); OnValidation; OnBeforeInsert; OnBeforeInsertOrUpdate; if fMapNonTransientFields.Count = 0 then begin raise EMVCActiveRecord.CreateFmt ('Cannot insert an entity if all fields are 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; FillPrimaryKey(fPrimaryKeySequenceName); end; end; end; SQL := SQLGenerator.CreateInsertSQL(fTableName, fMapNonTransientFields, fPrimaryKeyFieldName, fPrimaryKeyOptions); ExecNonQuery(SQL, True); OnAfterInsert; OnAfterInsertOrUpdate; end; function TMVCActiveRecord.InternalCount(const RQL: String): int64; var lSQL: string; begin lSQL := Self.SQLGenerator.CreateSelectCount(fTableName); if not RQL.IsEmpty then begin lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false); end; Result := GetScalar(lSQL, []); end; function TMVCActiveRecord.InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList; var lSQL: string; begin lSQL := SQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping); 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 := TDictionary.Create; fMapNonTransientFields := TDictionary.Create; InitTableInfo; end; function TMVCActiveRecord.GenerateSelectSQL: string; begin Result := SQLGenerator.CreateSelectSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions); end; function TMVCActiveRecord.GetBackEnd: string; begin if fBackendDriver.IsEmpty then begin fBackendDriver := GetBackEndByConnection(GetConnection); end; Result := fBackendDriver; end; class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64; const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord; begin Result := aClass.Create; if not Result.LoadByPK(aValue) then begin Result.Free; if RaiseExceptionIfNotFound then begin raise EMVCActiveRecordNotFound.Create('Data not found'); end else begin Result := nil; end; end; end; class function TMVCActiveRecordHelper.GetByPK(const aValue: int64; const RaiseExceptionIfNotFound: Boolean = True): T; var lActiveRecord: TMVCActiveRecord; begin Result := T.Create; lActiveRecord := TMVCActiveRecord(Result); if not lActiveRecord.LoadByPK(aValue) then begin Result.Free; if RaiseExceptionIfNotFound then begin raise EMVCActiveRecordNotFound.Create('Data not found'); end else begin Result := nil; end; end; end; class function TMVCActiveRecordHelper.GetFirstByWhere(const SQLWhere: string; const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean): T; var lList: TObjectList; begin lList := Where(SQLWhere, Params); try if lList.Count = 0 then begin if RaiseExceptionIfNotFound then raise EMVCActiveRecord.Create('Got 0 rows'); Exit(nil); end; Result := lList.Extract(lList.First); finally lList.Free; end; end; function TMVCActiveRecord.GetMapping: TMVCFieldsMapping; var lPair: TPair; i: Integer; begin 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; inc(i); end; end; Result := fMapping; end; class function TMVCActiveRecordHelper.GetOneByWhere(const SQLWhere: string; const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean): T; begin Result := GetFirstByWhere(SQLWhere, Params, false); if Result = nil then begin if RaiseExceptionIfNotFound then raise EMVCActiveRecord.Create('Got 0 rows when exactly 1 was expected'); end; 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.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 not allowed on "%s"', [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 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(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; var SQL: string; begin OnBeforeDelete; if not Assigned(fPrimaryKey) then raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]); SQL := SQLGenerator.CreateDeleteSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions, GetPK.AsInt64); ExecNonQuery(SQL, false); 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)); 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().HasValue then begin aParam.DataType := ftString; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableInt32)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftInteger; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableTDate)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftDate; aParam.Clear; Exit(True); end else begin aValue := TValue.From(aValue.AsType().Value); Result := True; end; end else if aValue.IsType(TypeInfo(NullableTTime)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftTime; aParam.Clear; Exit(True); end else begin aValue := TValue.From(aValue.AsType().Value); Result := True; end; end else if aValue.IsType(TypeInfo(NullableTDateTime)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftDateTime; aParam.Clear; Exit(True); end else begin aValue := TValue.From(aValue.AsType().Value); Result := True; end; end else if aValue.IsType(TypeInfo(NullableUInt32)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftInteger; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableInt64)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftLargeint; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableInt16)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftInteger; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableUInt64)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftLargeint; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableUInt16)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftInteger; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableBoolean)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := ftBoolean; aParam.Clear; Exit(True); end else begin aValue := TValue.From(aValue.AsType().Value); Result := True; end; end else if aValue.IsType(TypeInfo(NullableSingle)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := TFieldType.ftSingle; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableDouble)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := TFieldType.ftFloat; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end else if aValue.IsType(TypeInfo(NullableCurrency)) then begin if not aValue.AsType().HasValue then begin aParam.DataType := TFieldType.ftCurrency; aParam.Clear; Exit(True); end else begin aValue := aValue.AsType().Value; Result := True; end; end; if Result then begin MapTValueToParam(aValue, aParam); end; end; procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam); var lStream: TStream; lName: String; begin {$IFDEF NEXTGEN} lName := aValue.TypeInfo.NameFld.ToString; {$ELSE} lName := String(aValue.TypeInfo.Name); {$ENDIF} if (aValue.TypeInfo.Kind = tkRecord) then begin if MapNullableTValueToParam(aValue, aParam) then begin Exit; end; end; case aValue.TypeInfo.Kind of tkString, tkUString: begin case aParam.DataType of ftUnknown, ftString, ftWideString: begin aParam.AsString := aValue.AsString; 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, tkUString) [%s]', [lName]); end; end; end; {$IF Defined(SeattleOrBetter)} tkWideString: begin aParam.AsWideString := aValue.AsString; 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(); {$ELSE} lStream := aValue.AsType(); {$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; 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; // case aParam.DataType of // ftUnknown: // begin // { aParam.DataType could be pkUndefined for some RDBMS (es. MySQL), so we rely on Variant } // if (aValue.TypeInfo.Kind = tkClass) then // begin // if not aValue.IsInstanceOf(TStream) then // raise EMVCActiveRecord.CreateFmt('Unsupported type for param %s', [aParam.Name]); // lStream := aValue.AsType(false); // if Assigned(lStream) then // begin // lStream.Position := 0; // aParam.LoadFromStream(lStream, ftBlob); // end // else // begin // aParam.Clear; // end; // // end // else // begin // aParam.value := aValue.AsVariant; // end; // end; // ftString: // begin // aParam.AsString := aValue.AsString; // end; // ftWideString: // begin // aParam.AsWideString := aValue.AsString; // end; // ftLargeint: // begin // aParam.AsLargeInt := aValue.AsInt64; // end; // ftSmallint: // begin // aParam.AsSmallInt := aValue.AsInteger; // end; // ftInteger: // begin // aParam.AsInteger := aValue.AsInteger; // end; // ftLongWord: // begin // aParam.AsLongWord := aValue.AsInteger; // end; // ftWord: // begin // aParam.AsWord := aValue.AsInteger; // end; // ftDate: // begin // aParam.AsDate := Trunc(aValue.AsExtended); // end; // ftDateTime: // begin // aParam.AsDateTime := aValue.AsExtended; // end; // ftBoolean: // begin // aParam.AsBoolean := aValue.AsBoolean; // end; // ftMemo: // begin // aParam.AsMemo := AnsiString(aValue.AsString); // end; // ftWideMemo: // begin // aParam.AsWideMemo := aValue.AsString; // end; // ftBCD: // begin // aParam.AsBCD := aValue.AsCurrency; // end; // ftBlob: // begin // lStream := aValue.AsType(false); // if Assigned(lStream) then // begin // lStream.Position := 0; // aParam.LoadFromStream(lStream, ftBlob); // end // else // begin // aParam.Clear; // end; // end; // else // raise Exception.CreateFmt('Unsupported FieldType (%d) for param %s', [Ord(aParam.DataType), aParam.Name]); // end; end; procedure TMVCActiveRecord.LoadByDataset(const aDataSet: TDataSet; const aOptions: TMVCActiveRecordLoadOptions); var lItem: TPair; 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 lItem.Value.IsEmpty then begin continue; end; lField := aDataSet.FindField(lItem.Value); 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]); 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(id: int64): Boolean; var SQL: string; lDataSet: TDataSet; begin CheckAction(TMVCEntityAction.eaRetrieve); SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions, id); lDataSet := ExecQuery(SQL, [id], GetConnection); try Result := not lDataSet.Eof; if Result then begin LoadByDataset(lDataSet); end; finally lDataSet.Free; end; 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; begin // do nothing 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); 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 TMVCActiveRecordHelper.Select(const SQL: string; const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions): TObjectList; var lDataSet: TDataSet; lAR: TMVCActiveRecord; lHandled: Boolean; begin Result := TObjectList.Create(True); try lDataSet := ExecQuery(SQL, Params); 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 TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet; begin Result := TMVCActiveRecord.ExecQuery(SQL, Params); end; function TMVCActiveRecord.SelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList; begin Result := InternalSelectRQL(RQL, MaxRecordCount); end; class function TMVCActiveRecordHelper.SelectRQL(const RQL: string; const MaxRecordCount: Integer): TObjectList; var lAR: TMVCActiveRecord; lSQL: string; begin lAR := T.Create; try lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping).Trim; // LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL])); if lSQL.StartsWith('where', True) then lSQL := lSQL.Remove(0, 5).Trim; Result := Where(lSQL, []); 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.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 then begin if aValue.IsType then begin lPKValue := TValue.From(IntToNullableInt(aValue.AsInteger)); end; // // if aValue.AsType().HasValue then // begin // lPKValue := aValue; // end // else // begin // lPKValue.AsType().Clear; // end; end else if lPKValue.IsType then begin if aValue.AsType().HasValue then begin lPKValue := aValue; end else begin lPKValue.AsType().Clear; end; end else if lPKValue.IsType then begin if aValue.AsType().HasValue then begin lPKValue := aValue; end else begin lPKValue.AsType().Clear; end; end else if lPKValue.IsType then begin if aValue.AsType().HasValue then begin lPKValue := aValue; end else begin lPKValue.AsType().Clear; end; end else raise EMVCActiveRecord.Create('Invalid type for primary key'); 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; function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator; begin if not Assigned(fSQLGenerator) then begin GetConnection.Connected := True; fSQLGenerator := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd).Create(GetMapping); 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; begin Result := 'Table Name: ' + fTableName; for keyvalue in fMap do Result := Result + sLineBreak + #9 + keyvalue.Key.Name + ' = ' + keyvalue.Value; 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() then begin Result := Value.AsType().HasValue; if Result then Value := Value.AsType().Value; end else if Value.IsType() then begin Result := Value.AsType().HasValue; if Result then Value := Value.AsType().Value; end else if Value.IsType() then begin Result := Value.AsType().HasValue; if Result then Value := Value.AsType().Value; end else if Value.IsType() then begin Result := Value.AsType().HasValue; if Result then Value := Value.AsType().Value; end else if Value.IsType() then begin Result := Value.AsType().HasValue; if Result then Value := Value.AsType().Value; end else if Value.IsType() then begin Result := Value.AsType().HasValue; if Result then Value := Value.AsType().Value; end else raise EMVCActiveRecord.Create('Invalid primary key type [HINT: Use Int64 or NullableInt64, so that Store method is available too.]'); IsNullableType := True; end else begin Result := not Value.IsEmpty; end; end; procedure TMVCActiveRecord.Update; var SQL: string; begin CheckAction(TMVCEntityAction.eaUpdate); OnValidation; OnBeforeUpdate; OnBeforeInsertOrUpdate; if fMapNonTransientFields.Count = 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, fMapNonTransientFields, fPrimaryKeyFieldName, fPrimaryKeyOptions); ExecNonQuery(SQL, false); OnAfterUpdate; OnAfterInsertOrUpdate; end; class function TMVCActiveRecord.All(const aClass: TMVCActiveRecordClass): TObjectList; var lAR: TMVCActiveRecord; begin lAR := aClass.Create; try Result := Select(aClass, lAR.GenerateSelectSQL, []); finally lAR.Free; end; end; class function TMVCActiveRecordHelper.All: TObjectList; var lAR: TMVCActiveRecord; begin lAR := T.Create; try Result := Select(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(const SQLWhere: string; const Params: array of Variant): TObjectList; var lAR: TMVCActiveRecord; begin lAR := T.Create; try if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then begin Result := Select(lAR.GenerateSelectSQL + SQLWhere, Params); end else begin Result := Select(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params); end; finally lAR.Free; end; end; { PrimaryKeyAttribute } // constructor MVCPrimaryKeyAttribute.Create(const aFieldName: string); // begin // Create(aFieldName, []); // end; // // constructor MVCPrimaryKeyAttribute.Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions); // begin // inherited Create; // FieldName := aFieldName; // FieldOptions := aFieldOptions; // 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.Create; fProcessorsDict := TDictionary.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; { 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.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); begin inherited Create; fMapping := Mapping; end; function TMVCSQLGenerator.GetMapping: TMVCFieldsMapping; begin Result := fMapping; 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.GetRQLParser: TRQL2SQL; begin if fRQL2SQL = nil then begin fRQL2SQL := TRQL2SQL.Create; // (20); end; Result := fRQL2SQL; end; function TMVCSQLGenerator.GetSequenceValueSQL( const PKFieldName: String; const SequenceName: String; const Step: Integer = 1): String; begin Result := ''; end; function TMVCSQLGenerator.HasReturning: Boolean; begin Result := True; end; function TMVCSQLGenerator.HasSequences: Boolean; begin Result := True; end; function TMVCSQLGenerator.TableFieldsDelimited(const Map: TDictionary; const PKFieldName: string; const Delimiter: string): string; var lPair: TPair; begin for lPair in Map do begin if not lPair.Value.IsEmpty then begin Result := Result + lPair.Value + Delimiter; end; end; Result := Copy(Result, 1, Length(Result) - Length(Delimiter)); if not PKFieldName.IsEmpty then begin Result := PKFieldName + ',' + Result; 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); begin inherited Create; FieldName := aFieldName; FieldOptions := aFieldOptions; SequenceName := aSequenceName; end; { EMVCActiveRecordNotFound } procedure EMVCActiveRecordNotFound.AfterConstruction; begin inherited; fHttpErrorCode := http_status.NotFound; end; initialization gLock := TObject.Create; gCtx := TRttiContext.Create; gCtx.FindType(''); finalization gCtx.Free; gLock.Free; end.