All Projects FPC fpcprojects fpprofilerfpGUI Lazarus Packages PatchesLazarus CCR Mantis pas2js

View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0038181FPCFCLpublic2020-12-07 15:012021-01-05 12:34
ReporterZdravko Gabrovski Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status assignedResolutionopen 
PlatformallOSall 
Product Version3.3.1 
Summary0038181: fcl-db: fix an issue with FieldDefs Code Page and String Field DataSize in TBufDataSet
DescriptionIn a TBufdataset for a backward compatibility, the datasize of FieldDef for string data type becomes = of FieldDef Size property, which comes (probably) for a compatibility with old code.
It works prefect for all non-unicode characters, which have character size = 1.
But if you want to use UTF8 Unicode characters (for example Cyrillic letters) it will not work OK.
After some digging, I found that the problem comes from TFiedDef creation , which creates FieldDef always with CP_ANSI encoding. In this case, GetDataSize method always returns DataSize=Size, which breaks UTF8 Unicode characters.

I did the following patch:

in db.pas - little modification, that allow to modify code page of particular TFieldDef (just add write property handler of public CodePage property).
in bufdataset.pas :
- Create a new Public procedure "SetCodePage" with parameter new code page; The procedure sets a new code page to all String FieldDefs in TBufDataSet;
- Create a new event Handler "OnCreateDataSet" which is reached before Field from FieldDef creation, a perfect place to setup a new code page of the TDufdataset.

Everything is designed for keep of backward compatibility for a current TBufDataSet implementation.

 



TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

Zdravko Gabrovski

2020-12-07 15:01

reporter  

bufdataset.diff (1,668 bytes)    
Index: packages/fcl-db/src/base/bufdataset.pas
===================================================================
--- packages/fcl-db/src/base/bufdataset.pas	(revision 47386)
+++ packages/fcl-db/src/base/bufdataset.pas	(working copy)
@@ -518,6 +518,7 @@
     FFieldBufPositions : array of longint;
     FAllPacketsFetched : boolean;
     FOnUpdateError  : TResolverErrorEvent;
+    FOnCreateDataset : TDataSetNotifyEvent;
 
     FBlobBuffers      : array of PBlobBuffer;
     FUpdateBlobBuffers: array of PBlobBuffer;
@@ -665,9 +666,12 @@
     property IndexName : String read GetIndexName write SetIndexName;
     property IndexFieldNames : String read GetIndexFieldNames write SetIndexFieldNames;
     property UniDirectional: boolean read GetBufUniDirectional write SetBufUniDirectional default False;
+    property OnCreateDataset: TDataSetNotifyEvent read FOnCreateDataset write FOnCreateDataset;
   end;
 
   TBufDataset = class(TCustomBufDataset)
+  public
+    procedure SetCodePage( cp : TSystemCodePage );
   published
     property MaxIndexesCount;
     // TDataset stuff
@@ -910,6 +914,17 @@
     end;
 end;
 
+{ TBufDataset }
+
+procedure TBufDataset.SetCodePage(cp: TSystemCodePage);
+var
+  F: TCollectionItem;
+begin
+  for F In FieldDefs do
+    if TFieldDef(F).DataType=ftString then
+      TFieldDef(F).CodePage := cp;
+end;
+
 { TCustomBufDataset.TBufDatasetIndex }
 
 destructor TCustomBufDataset.TBufDatasetIndex.Destroy;
@@ -3541,6 +3556,8 @@
 
 begin
   CheckInactive;
+  if Assigned(FOnCreateDataset) then
+    FOnCreateDataset( Self );
   if ((Fields.Count=0) or (FieldDefs.Count=0)) then
     begin
     if (FieldDefs.Count>0) then
bufdataset.diff (1,668 bytes)   
db.diff (744 bytes)    
Index: packages/fcl-db/src/base/db.pas
===================================================================
--- packages/fcl-db/src/base/db.pas	(revision 47386)
+++ packages/fcl-db/src/base/db.pas	(working copy)
@@ -193,7 +193,7 @@
     property CharSize: Word read GetCharSize;
     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
     property Required: Boolean read FRequired write SetRequired;
-    Property Codepage : TSystemCodePage Read FCodePage;
+    Property Codepage : TSystemCodePage Read FCodePage write FCodePage;
   Published
     property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
     property DataType: TFieldType read FDataType write SetDataType;
db.diff (744 bytes)   

Michael Van Canneyt

2020-12-07 15:11

administrator   ~0127422

Thank you, I will use this as the basis of the implementation.

LacaK

2020-12-08 14:33

developer   ~0127458

It was intentionally that in TFieldDef is CodePage read only.
Intention was that TDataSet descendants must have only control over creation of Fields.
(user change can cause damage)
There is function TFieldDefs.Add with CodePage parameter which was designed to be called by TDataSet descendants.
It is only my personal feeling, that if TBufDataSet should support UTF-8 then it must be configurable at TBufDataset level ... but I am not sure if for example indexes are UTF-8 aware.

Michael Van Canneyt

2020-12-08 17:29

administrator   ~0127461

@Laco,

The idea is:
In BufDataset you can create manually fielddefs and set the property on a per field basis.
I will let TFieldDef.Codepage be read-only public, but have a protected setter.

TBufDataset will create a TBufFieldDef descendent which allows to set the codepage.

Zdravko Gabrovski

2021-01-03 11:24

reporter   ~0128040

i add a little more changes:
- to pullish a property CurrentIndexBuf
- to publish a property UpdateBuffer

I am using this to have a way to save somewhere changes in Bufdataset, This is helpful if I want to retry apply updates after failover:

Object that will save changes:

  TBufDataSetSaveObject = Class( TObject )
      fUpdateErrDataset, fInsertErrDataSet, fDeleteErrDataset : TBufDataset;
      fBFDS : TCustomBufDataset;
      fBFDSBeforePostHandler: TDataSetNotifyEvent;
      fBFDSAfterPostHandler : TDataSetNotifyEvent;
      fBFDSAfterDeleteHandler : TDataSetNotifyEvent;
      fBFDSAfterScrollHandler : TDataSetNotifyEvent;
      procedure CopyRecord(FromDS,ToDs : TBufDataset; SkipKeyField : Boolean = False );
    Public
      UpdateErrFlag : Boolean;
      CurrentRecord : Variant;
      Constructor Create;
      Constructor Create( BFDS : TCustomBufDataset );
      Destructor Destroy; override;
      procedure SaveModifiedData;
      procedure RestoreModifiedData;

  end;

{ TBufDataSetSaveObject }

procedure TBufDataSetSaveObject.CopyRecord(FromDS, ToDs: TBufDataset;
  SkipKeyField: Boolean);
var i, j : integer;
begin
j := 0;
if SkipKeyField then
  j := 1;
for i := j to ToDs.fieldDefs.Count - 1 do
 ToDs.fieldByName( ToDs.fieldDefs[ i ].Name ).Value :=
     FromDs.fieldByName( ToDs.fieldDefs[ i ].Name ).Value;
end;

constructor TBufDataSetSaveObject.Create;
begin
  //
Inherited;
end;

constructor TBufDataSetSaveObject.Create( BFDS: TCustomBufDataset );
begin
  //
inherited Create;
fBFDS := BFDS;
UpdateErrFlag := False;
fUpdateErrDataset := TBufDataset.Create(nil);
fInsertErrDataSet := TBufDataset.Create(nil);
fDeleteErrDataset := TBufDataset.Create(nil);
fUpdateErrDataset.FieldDefs.Assign( BFDS.FieldDefs );
fInsertErrDataset.FieldDefs.Assign( BFDS.FieldDefs );
fdeleteErrDataset.FieldDefs.Assign( BFDS.FieldDefs );
fUpdateErrDataset.CreateDataset;
fInsertErrDataset.CreateDataset;
fDeleteErrDataset.CreateDataset;
SaveModifiedData;
end;

destructor TBufDataSetSaveObject.Destroy;
begin

FreeAndnil( fDeleteErrDataset );
FreeAndnil( fUpdateErrDataset );
FreeAndnil( fInsertErrDataSet );
inherited Destroy;

end;

procedure TBufDataSetSaveObject.SaveModifiedData;
var
  ii, CC: Integer;
  DsToStoreDiff : TBufDataSet;
begin
UpdateErrFlag := False;

fUpdateErrDataset.Close;
fInsertErrDataset.Close;
fDeleteErrDataset.Close;

fUpdateErrDataset.CreateDataset;
fInsertErrDataset.CreateDataset;
fDeleteErrDataset.CreateDataset;
if fBFDS.State in dsEditModes then
  fBFDS.Cancel;


CC := fBFDS.ChangeCount;
if CC > 0 then begin
  try
  fBFDS.DisableControls;

  fBFDSAfterPostHandler := fBFDS.AfterPost;
  fBFDS.AfterPost := nil;
  fBFDSAfterDeleteHandler := fBFDS.AfterDelete;
  fBFDS.AfterDelete := nil;
  fBFDSAfterScrollHandler := fBFDS.AfterScroll;
  fBFDS.AfterScroll := nil;
  fBFDSBeforePostHandler := fBFDS.BeforePost;
  fBFDS.BeforePost := nil;
  CurrentRecord := fBFDS.fields[ 0 ].Value;

  for ii := 0 to cc-1 do begin
    case fBFDS.UpdateBuffer[ ii ].UpdateKind of
      ukModify: DsToStoreDiff := fUpdateErrDataset;
      ukInsert: DsToStoreDiff := fInsertErrDataSet;
      ukDelete: DsToStoreDiff := fDeleteErrDataset;
      end;
    // Hold here record change!
    fBFDS.CurrentIndexBuf.GotoBookmark(@fBFDS.UpdateBuffer[ ii ].BookmarkData);
    DsToStoreDiff.Append;
    CopyRecord( tBufDataSet( fBFDS ), DsToStoreDiff );
    DsToStoreDiff.post;
    UpdateErrFlag := True;
    end;
  finally


  end;
  end;
end;

procedure TBufDataSetSaveObject.RestoreModifiedData;

begin
try
fBFDS.DisableControls;
if not fBFDS.Active then
  fBFDS.Open;

fUpdateErrDataset.First;
While Not fUpdateErrDataset.EOF do begin
  if fBFDS.Locate(fBFDS.fields[ 0 ].FieldName, fUpdateErrDataset.fields[ 0 ].Value, [] ) then begin
    fBFDS.Edit;
    CopyRecord( fUpdateErrDataset, tBufDataSet( fBFDS ) );
    fBFDS.post;
    end
  else
    Raise Exception.Create('Match record failed in update for fBFDS '+fBFDS.Name +' for field value '+VarToStr(fUpdateErrDataset.fields[ 0 ].Value));
  fUpdateErrDataset.Next;
  end;
// Apply again a list of the inserted fields
fInsertErrDataset.First;
While Not fInsertErrDataset.EOF do begin
  fBFDS.Append;
  CopyRecord( fInsertErrDataset, tBufDataSet( fBFDS ), True );
  fBFDS.post;
  fInsertErrDataset.Next;
  end;
// Apply again a list of the deleted fields
fDeleteErrDataset.First;
While Not fDeleteErrDataset.EOF do begin
  if fBFDS.Locate(fBFDS.fields[ 0 ].FieldName, fDeleteErrDataset.fields[ 0 ].Value, [] ) then begin
    fBFDS.Delete;
    end
  else
    Raise Exception.Create('Match record failed in delete for fBFDS '+fBFDS.Name +' for field value '+VarToStr(fDeleteErrDataset.fields[ 0 ].Value));
  fDeleteErrDataset.Next;
  end;

finally
fBFDS.Locate(fBFDS.fields[ 0 ].FieldName, CurrentRecord, [] );
fBFDS.EnableControls;
fBFDS.AfterPost := fBFDSAfterPostHandler;
fBFDS.AfterDelete := fBFDSAfterDeleteHandler;
fBFDS.AfterScroll := fBFDSAfterScrollHandler;
fBFDS.BeforePost := fBFDSBeforePostHandler;
end;

end;

Example ussage in a case of failover:

procedure TBasicForm.DBReconnect(Data: TObject);
var
  SaveObject : TBufDataSetSaveObject;
  LastError: String;

begin

try

  try
  // Create object that will hold a changes.
  SaveObject := TBufDataSetSaveObject.Create( TCustomBufDataset( Data ) );

  TSQLQuery( Data ).Close;
  TSQLQuery( Data ).DataBase.Close();
  TSQLQuery( Data ).DataBase.open();
  TSQLQuery( Data ).Open;

  if SaveObject.UpdateErrFlag then
    SaveObject.RestoreModifiedData;

  finally
  SaveObject.Free;
  end;
except
  on E : Exception do begin
    LastError := '[TBasicForm.DBReconnect]('+Self.Name+') Query='+TCustomBufDataset( Data ).Name+' unhandled exception '+E.Message;
    WriteToLog( LogFile, LastError,CurrentUserLogged );
    Raise EMySilentException.Create(MainStatusBar, LastError );
    end;
end;
bufdataset1.diff (2,777 bytes)    
Index: packages/fcl-db/src/base/bufdataset.pas
===================================================================
--- packages/fcl-db/src/base/bufdataset.pas	(revision 47386)
+++ packages/fcl-db/src/base/bufdataset.pas	(working copy)
@@ -518,6 +518,7 @@
     FFieldBufPositions : array of longint;
     FAllPacketsFetched : boolean;
     FOnUpdateError  : TResolverErrorEvent;
+    FOnCreateDataset : TDataSetNotifyEvent;
 
     FBlobBuffers      : array of PBlobBuffer;
     FUpdateBlobBuffers: array of PBlobBuffer;
@@ -558,7 +559,6 @@
     procedure BuildIndexes;
     procedure RemoveRecordFromIndexes(const ABookmark : TBufBookmark);
     procedure InternalCreateIndex(F: TBufDataSetIndex); virtual;
-    Property CurrentIndexBuf : TBufIndex Read GetCurrentIndexBuf;
     Property CurrentIndexDef : TBufDatasetIndex Read FCurrentIndexDef;
     Property BufIndexDefs[Aindex : Integer] : TBufDatasetIndex Read GetBufIndexDef;
     Property BufIndexes[Aindex : Integer] : TBufIndex Read GetBufIndex;
@@ -653,6 +653,8 @@
     function BookmarkValid(ABookmark: TBookmark): Boolean; override;
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
     Procedure CopyFromDataset(DataSet : TDataSet;CopyData : Boolean=True);
+    Property CurrentIndexBuf : TBufIndex Read GetCurrentIndexBuf;
+    property UpdateBuffer : TRecordsUpdateBuffer read FUpdateBuffer;
     property ChangeCount : Integer read GetChangeCount;
     property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount default 2;
     property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
@@ -665,9 +667,12 @@
     property IndexName : String read GetIndexName write SetIndexName;
     property IndexFieldNames : String read GetIndexFieldNames write SetIndexFieldNames;
     property UniDirectional: boolean read GetBufUniDirectional write SetBufUniDirectional default False;
+    property OnCreateDataset: TDataSetNotifyEvent read FOnCreateDataset write FOnCreateDataset;
   end;
 
   TBufDataset = class(TCustomBufDataset)
+  public
+    procedure SetCodePage( cp : TSystemCodePage );
   published
     property MaxIndexesCount;
     // TDataset stuff
@@ -910,6 +915,17 @@
     end;
 end;
 
+{ TBufDataset }
+
+procedure TBufDataset.SetCodePage(cp: TSystemCodePage);
+var
+  F: TCollectionItem;
+begin
+  for F In FieldDefs do
+    if TFieldDef(F).DataType=ftString then
+      TFieldDef(F).CodePage := cp;
+end;
+
 { TCustomBufDataset.TBufDatasetIndex }
 
 destructor TCustomBufDataset.TBufDatasetIndex.Destroy;
@@ -3541,6 +3557,8 @@
 
 begin
   CheckInactive;
+  if Assigned(FOnCreateDataset) then
+    FOnCreateDataset( Self );
   if ((Fields.Count=0) or (FieldDefs.Count=0)) then
     begin
     if (FieldDefs.Count>0) then
bufdataset1.diff (2,777 bytes)   

Michael Van Canneyt

2021-01-03 11:39

administrator   ~0128041

No, no, no... Please don't reuse issues for totally unrelated changes.
You must create a new issue for such things.

And I will not apply a patch that exposes CurrentIndexBuf and UpdateBuffer.
These properties are purely internal to TBufDataset.
By exposing them, you force us to maintain that API indefinitely.

Lastly, If you look at the changes I did recently to allow async updates, you can override some methods to
make the changes you need in a descendent class.

Zdravko Gabrovski

2021-01-05 12:34

reporter   ~0128088

OK, agree, you could apply only initial patch.
Where I can look the changes you did for async updates?

Issue History

Date Modified Username Field Change
2020-12-07 15:01 Zdravko Gabrovski New Issue
2020-12-07 15:01 Zdravko Gabrovski File Added: bufdataset.diff
2020-12-07 15:01 Zdravko Gabrovski File Added: db.diff
2020-12-07 15:09 Michael Van Canneyt Assigned To => Michael Van Canneyt
2020-12-07 15:09 Michael Van Canneyt Status new => assigned
2020-12-07 15:11 Michael Van Canneyt Note Added: 0127422
2020-12-08 14:33 LacaK Note Added: 0127458
2020-12-08 17:29 Michael Van Canneyt Note Added: 0127461
2021-01-03 11:24 Zdravko Gabrovski Note Added: 0128040
2021-01-03 11:24 Zdravko Gabrovski File Added: bufdataset1.diff
2021-01-03 11:39 Michael Van Canneyt Note Added: 0128041
2021-01-05 12:34 Zdravko Gabrovski Note Added: 0128088