From 57f9992bb438b385583fd39ca8388c089cce43df Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Sun, 25 Apr 2021 22:40:06 +0200 Subject: [PATCH] First version of 'merge' method - used to create a UOW in case of updating a list of active records --- samples/activerecord_showcase/EntitiesU.pas | 10 ++ samples/activerecord_showcase/MainFormU.dfm | 15 +- samples/activerecord_showcase/MainFormU.pas | 144 ++++++++++++++++++-- samples/commons/BusinessObjectsU.pas | 2 +- sources/MVCFramework.ActiveRecord.pas | 21 +++ 5 files changed, 177 insertions(+), 15 deletions(-) diff --git a/samples/activerecord_showcase/EntitiesU.pas b/samples/activerecord_showcase/EntitiesU.pas index e86dc7e2..600c0ed0 100644 --- a/samples/activerecord_showcase/EntitiesU.pas +++ b/samples/activerecord_showcase/EntitiesU.pas @@ -124,6 +124,7 @@ type public constructor Create; override; destructor Destroy; override; + function ToString: String; override; property ID: NullableInt64 read fID write fID; property Code: NullableString read fCode write fCode; property CompanyName: NullableString read fCompanyName write fCompanyName; @@ -436,6 +437,15 @@ begin inherited; end; +function TCustomer.ToString: String; +begin + Result := ''; + if PKIsNull then + Result := ''; + Result := Format('[ID: %6s][CODE: %6s][CompanyName: %15s][City: %10s][Rating: %3d][Note: %s]',[ + Result, fCode.ValueOrDefault, fCompanyName.ValueOrDefault, fCity, fRating.ValueOrDefault, fNote]); +end; + constructor TOrderDetail.Create; begin inherited Create; diff --git a/samples/activerecord_showcase/MainFormU.dfm b/samples/activerecord_showcase/MainFormU.dfm index d586e29f..60b19b22 100644 --- a/samples/activerecord_showcase/MainFormU.dfm +++ b/samples/activerecord_showcase/MainFormU.dfm @@ -2,7 +2,7 @@ object MainForm: TMainForm Left = 0 Top = 0 Caption = 'TMVCActiveRecord - ShowCase' - ClientHeight = 700 + ClientHeight = 731 ClientWidth = 635 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -15,7 +15,7 @@ object MainForm: TMainForm OnShow = FormShow DesignSize = ( 635 - 700) + 731) PixelsPerInch = 96 TextHeight = 13 object btnCRUD: TButton @@ -40,7 +40,7 @@ object MainForm: TMainForm Left = 135 Top = 8 Width = 492 - Height = 684 + Height = 715 Anchors = [akLeft, akTop, akRight, akBottom] Ctl3D = True DoubleBuffered = True @@ -194,6 +194,15 @@ object MainForm: TMainForm TabOrder = 17 OnClick = btnJSON_XML_TypesClick end + object btnMerge: TButton + Left = 8 + Top = 677 + Width = 121 + Height = 33 + Caption = 'Merge' + TabOrder = 18 + OnClick = btnMergeClick + end object FDConnection1: TFDConnection Left = 192 Top = 56 diff --git a/samples/activerecord_showcase/MainFormU.pas b/samples/activerecord_showcase/MainFormU.pas index 3da4fcf3..3c86320e 100644 --- a/samples/activerecord_showcase/MainFormU.pas +++ b/samples/activerecord_showcase/MainFormU.pas @@ -23,7 +23,8 @@ uses FireDAC.Stan.Async, FireDAC.Phys, FireDAC.VCLUI.Wait, - Data.DB, FireDAC.Comp.Client, MVCFramework.Nullables; + Data.DB, FireDAC.Comp.Client, MVCFramework.Nullables, + MVCFramework.ActiveRecord, System.Generics.Collections; type TMainForm = class(TForm) @@ -46,6 +47,7 @@ type btnClientGeneratedPK: TButton; btnAttributes: TButton; btnJSON_XML_Types: TButton; + btnMerge: TButton; procedure btnCRUDClick(Sender: TObject); procedure btnInheritanceClick(Sender: TObject); procedure btnMultiThreadingClick(Sender: TObject); @@ -66,9 +68,13 @@ type procedure btnClientGeneratedPKClick(Sender: TObject); procedure btnAttributesClick(Sender: TObject); procedure btnJSON_XML_TypesClick(Sender: TObject); + procedure btnMergeClick(Sender: TObject); private procedure Log(const Value: string); procedure LoadCustomers; + procedure Merge(CurrentList: TObjectList; NewList: TObjectList); + function KeyExists(const NewList: TObjectList; const KeyValue: Integer; + out Index: Integer): Boolean; public { Public declarations } end; @@ -81,14 +87,12 @@ implementation {$R *.dfm} uses - MVCFramework.ActiveRecord, EntitiesU, System.Threading, - System.Generics.Collections, MVCFramework.DataSet.Utils, MVCFramework.RQL.Parser, System.Math, - FDConnectionConfigU, EngineChoiceFormU; + FDConnectionConfigU, EngineChoiceFormU, System.Rtti; const Cities: array [0 .. 4] of string = ('Rome', 'New York', 'London', 'Melbourne', 'Berlin'); @@ -431,6 +435,43 @@ begin end; end; +procedure TMainForm.btnMergeClick(Sender: TObject); +var + lCustomer: TCustomer; + lCustomers: TObjectList; + lCustomersChanges: TObjectList; +begin + TMVCActiveRecord.DeleteAll(TCustomer); + LoadCustomers; + lCustomers := TMVCActiveRecord.All; + try + lCustomersChanges := TMVCActiveRecord.SelectRQL('eq(city,"Rome")', 1000); + try + lCustomersChanges.Delete(0); + lCustomersChanges[1].CompanyName := 'Changed'; + lCustomer := TCustomer.Create; + lCustomersChanges.Add(lCustomer); + lCustomer.Code := 'C8765'; + lCustomer.CompanyName := 'New Company'; + lCustomer.City := 'New City'; + lCustomer.Rating := 3; + + lCustomer := TCustomer.Create; + lCustomersChanges.Add(lCustomer); + lCustomer.Code := 'C9898'; + lCustomer.CompanyName := 'New Company2'; + lCustomer.City := 'New City2'; + lCustomer.Rating := 5; + + Merge(lCustomers, lCustomersChanges); + finally + lCustomers.Free; + end; + finally + lCustomersChanges.Free; + end; +end; + procedure TMainForm.btnMultiThreadingClick(Sender: TObject); var lTasks: TArray; @@ -474,12 +515,11 @@ begin end; end; - lTasks := [ - TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),TTask.Run(lProc), + lTasks := [TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), - TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc) - ]; + TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), + TTask.Run(lProc)]; TTask.WaitForAll(lTasks); ShowMessage('Just inserted ' + TMVCActiveRecord.Count(TCustomer, @@ -1153,7 +1193,7 @@ begin Log('Now there are ' + TMVCActiveRecord.Count().ToString + ' row/s for entity ' + TCustomerWithSpaces.ClassName); - //gets the last inserted customer + // gets the last inserted customer lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert(not lCustomer.Code.HasValue); @@ -1249,8 +1289,7 @@ begin {$ELSE} Caption := Caption + ' WITHOUT SEQUENCES'; {$ENDIF} - btnWithSpaces.Enabled := - (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql') or + btnWithSpaces.Enabled := (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql') or (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'firebird') or (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'interbase') or (ActiveRecordConnectionsRegistry.GetCurrentBackend = 'sqlite'); @@ -1286,4 +1325,87 @@ begin Memo1.Update; end; +function TMainForm.KeyExists(const NewList: TObjectList; 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.AsInt64 = KeyValue then + begin + Index := I; + Exit(True); + end; + end; +end; + +procedure TMainForm.Merge(CurrentList, NewList: TObjectList); +var + lToDelete, lToUpdate, lToInsert: TObjectList; + I: Integer; + lFoundAtIndex: Integer; + lCurrPKValue: Integer; + lPKValue: TValue; +begin + lToDelete := TObjectList.Create(False); + try + lToUpdate := TObjectList.Create(False); + try + lToInsert := TObjectList.Create(False); + try + lToDelete.AddRange(CurrentList); + for I := 0 to NewList.Count - 1 do + begin + if NewList[I].PKIsNull then + begin + lToInsert.Add(NewList[I]); + Continue; + end; + lCurrPKValue := NewList[I].GetPK.AsInteger; + if KeyExists(CurrentList, lCurrPKValue, lFoundAtIndex) then + begin + // update + lToUpdate.Add(NewList[I]); + if KeyExists(lToDelete, lCurrPKValue, lFoundAtIndex) then + begin + lToDelete.Delete(lFoundAtIndex); + end + else + begin + raise EMVCActiveRecordNotFound.CreateFmt + ('Cannot update a non existent record [PK: %s]', [lCurrPKValue.ToString]); + end; + end + else + begin + // insert + lToInsert.Add(NewList[I]); + end; + end; + + for I := 0 to lToInsert.Count - 1 do + begin + Log('INSERT: ' + lToInsert[I].ToString); + end; + for I := 0 to lToUpdate.Count - 1 do + begin + Log('UPDATE: ' + lToUpdate[I].ToString); + end; + for I := 0 to lToDelete.Count - 1 do + begin + Log('DELETE: ' + lToDelete[I].ToString); + end; + finally + lToInsert.Free; + end; + finally + lToUpdate.Free; + end; + finally + lToDelete.Free; + end; +end; + end. diff --git a/samples/commons/BusinessObjectsU.pas b/samples/commons/BusinessObjectsU.pas index e4d9dc3a..1f2007cd 100644 --- a/samples/commons/BusinessObjectsU.pas +++ b/samples/commons/BusinessObjectsU.pas @@ -2,7 +2,7 @@ // // Delphi MVC Framework // -// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team +// Copyright (c) 2010-2021 Daniele Teti and the DMVCFramework Team // // https://github.com/danieleteti/delphimvcframework // diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas index fd984e8f..a2ba2f51 100644 --- a/sources/MVCFramework.ActiveRecord.pas +++ b/sources/MVCFramework.ActiveRecord.pas @@ -282,6 +282,8 @@ type 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); // dynamic access @@ -1293,6 +1295,25 @@ begin 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;