From c02351da6396cd7e470ff8382ca52db69af92b5a Mon Sep 17 00:00:00 2001 From: joost Date: Mon, 2 Jul 2012 11:42:05 +0000 Subject: [PATCH] * Implemented autoincremental fields for TBufDataset git-svn-id: trunk@21757 - --- packages/fcl-db/src/base/bufdataset.pas | 54 ++++++++++--- .../fcl-db/src/base/xmldatapacketreader.pp | 23 ++++-- .../fcl-db/tests/testspecifictbufdataset.pas | 78 ++++++++++++++++++- 3 files changed, 133 insertions(+), 22 deletions(-) diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index 7d9bf54090..e271f51d03 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/packages/fcl-db/src/base/bufdataset.pas @@ -353,7 +353,7 @@ type constructor create(AStream : TStream); virtual; // Load a dataset from stream: // Load the field-definitions from a stream. - procedure LoadFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract; + procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); virtual; abstract; // Is called before the records are loaded procedure InitLoadRecords; virtual; abstract; // Return the RowState of the current record, and the order of the update @@ -367,7 +367,7 @@ type // Store a dataset to stream: // Save the field-definitions to a stream. - procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract; + procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); virtual; abstract; // Save a record from the current record-buffer to the stream procedure StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract; // Is called after all records are stored @@ -381,8 +381,8 @@ type TFpcBinaryDatapacketReader = class(TDataPacketReader) public - procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override; - procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override; + procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); override; + procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); override; function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override; procedure FinalizeStoreRecords; override; function GetCurrentRecord : boolean; override; @@ -416,6 +416,8 @@ type FOpen : Boolean; FUpdateBuffer : TRecordsUpdateBuffer; FCurrentUpdateBuffer : integer; + FAutoIncValue : longint; + FAutoIncField : TAutoIncField; FIndexDefs : TIndexDefs; @@ -765,6 +767,7 @@ begin FIndexesCount:=0; FIndexDefs := TIndexDefs.Create(Self); + FAutoIncValue:=-1; SetLength(FUpdateBuffer,0); SetLength(FBlobBuffers,0); @@ -1120,6 +1123,7 @@ var IndexNr : integer; i : integer; begin + FAutoIncField:=nil; if not Assigned(FDatasetReader) and (FileName<>'') then begin FFileStream := TFileStream.Create(FileName,fmOpenRead); @@ -1132,20 +1136,22 @@ begin // reading from a stream in some other way implemented by a descendent) // If there are less fields then FieldDefs we know for sure that the dataset // is not (correctly) created. - + // commented for now. If there are constant expressions in the select // statement they are ftunknown, and not created. // See mantis #22030 - + // if Fields.Count-1) and (fields[i] is TAutoIncField) and not assigned(FAutoIncField) then + FAutoIncField := TAutoIncField(fields[i]); InitDefaultIndexes; CalcRecordSize; @@ -1218,6 +1224,8 @@ begin SetLength(FFieldBufPositions,0); + FAutoIncValue:=-1; + if assigned(FParser) then FreeAndNil(FParser); FReadFromFile:=false; end; @@ -2195,6 +2203,8 @@ Var ABuff : TRecordBuffer; i : integer; blobbuf : tbufblobfield; NullMask : pbyte; + li : longint; + StoreReadOnly: boolean; ABookmark : PBufBookmark; begin @@ -2215,6 +2225,21 @@ begin if State = dsInsert then begin + if assigned(FAutoIncField) then + begin + li := FAutoIncValue; + // In principle all TAutoIncfields are read-only, but in theory it is + // possible to set readonly to false. + StoreReadOnly:=FAutoIncField.ReadOnly; + FAutoIncField.ReadOnly:=false; + try + FAutoIncField.SetData(@li); + finally + FAutoIncField.ReadOnly:=FAutoIncField.ReadOnly; + end; + inc(FAutoIncValue); + end; + // The active buffer is the newly created TDataset record, // from which the bookmark is set to the record where the new record should be // inserted @@ -2656,7 +2681,7 @@ begin try //CheckActive; ABookMark:=@ATBookmark; - FDatasetReader.StoreFieldDefs(FieldDefs); + FDatasetReader.StoreFieldDefs(FieldDefs,FAutoIncValue); StoreDSState:=SetTempState(dsFilter); ScrollResult:=FCurrentIndex.ScrollFirst; @@ -2748,6 +2773,7 @@ begin end else raise Exception.Create(SErrNoFieldsDefined); + FAutoIncValue:=1; end; // When a filename is set, do not read from this file AStoreFilename:=FFileName; @@ -2777,7 +2803,7 @@ procedure TCustomBufDataset.IntLoadFielddefsFromFile; begin FieldDefs.Clear; - FDatasetReader.LoadFielddefs(FieldDefs); + FDatasetReader.LoadFielddefs(FieldDefs, FAutoIncValue); if DefaultFields then CreateFields else @@ -3418,7 +3444,7 @@ end; const FpcBinaryIdent = 'BinBufDataset'; -procedure TFpcBinaryDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs); +procedure TFpcBinaryDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs; var AnAutoIncValue: integer); var FldCount : word; i : integer; @@ -3439,9 +3465,11 @@ begin if Stream.ReadByte = 1 then Attributes := Attributes + [faReadonly]; end; + Stream.ReadBuffer(i,sizeof(i)); + AnAutoIncValue := i; end; -procedure TFpcBinaryDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs); +procedure TFpcBinaryDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs; AnAutoIncValue: integer); var i : integer; begin Stream.Write(FpcBinaryIdent[1],length(FpcBinaryIdent)); @@ -3459,6 +3487,8 @@ begin else Stream.WriteByte(0); end; + i := AnAutoIncValue; + Stream.WriteBuffer(i,sizeof(i)); end; function TFpcBinaryDatapacketReader.GetRecordRowState(out AUpdOrder : Integer) : TRowState; diff --git a/packages/fcl-db/src/base/xmldatapacketreader.pp b/packages/fcl-db/src/base/xmldatapacketreader.pp index 7dcd5e58a7..ce443f59e0 100644 --- a/packages/fcl-db/src/base/xmldatapacketreader.pp +++ b/packages/fcl-db/src/base/xmldatapacketreader.pp @@ -48,10 +48,10 @@ type FLastChange : integer; public destructor destroy; override; - procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override; + procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); override; procedure StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); override; procedure FinalizeStoreRecords; override; - procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override; + procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); override; procedure InitLoadRecords; override; function GetCurrentRecord : boolean; override; function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override; @@ -123,7 +123,7 @@ begin inherited destroy; end; -procedure TXMLDatapacketReader.LoadFieldDefs(AFieldDefs : TFieldDefs); +procedure TXMLDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs; var AnAutoIncValue: integer); function GetNodeAttribute(const aNode : TDOMNode; AttName : String) : string; var AnAttr : TDomNode; @@ -139,6 +139,7 @@ var i : integer; FTString : string; SubFTString : string; AFieldNode : TDOMNode; + AnAutoIncNode: TDomNode; begin ReadXMLFile(XMLDocument,Stream); @@ -175,15 +176,20 @@ begin end; end; - FChangeLogNode := MetaDataNode.FindNode('PARAMS'); - if assigned(FChangeLogNode) then - FChangeLogNode := FChangeLogNode.Attributes.GetNamedItem('CHANGE_LOG'); + FParamsNode := MetaDataNode.FindNode('PARAMS'); + if assigned(FParamsNode) then + begin + FChangeLogNode := FParamsNode.Attributes.GetNamedItem('CHANGE_LOG'); + AnAutoIncNode := FParamsNode.Attributes.GetNamedItem('AUTOINCVALUE'); + if assigned(AnAutoIncNode) then + AnAutoIncValue := StrToIntDef(AnAutoIncNode.NodeValue,-1); + end; FRowDataNode := DataPacketNode.FindNode('ROWDATA'); FRecordNode := nil; end; -procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs); +procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs; AnAutoIncValue: integer); var i,p : integer; AFieldNode : TDOMElement; @@ -219,6 +225,9 @@ begin MetaDataNode.AppendChild(FieldsNode); FParamsNode := XMLDocument.CreateElement('PARAMS'); + if AnAutoIncValue>-1 then + (FParamsNode as TDomElement).SetAttribute('AUTOINCVALUE',IntToStr(AnAutoIncValue)); + MetaDataNode.AppendChild(FParamsNode); DataPacketNode.AppendChild(MetaDataNode); FRowDataNode := XMLDocument.CreateElement('ROWDATA'); diff --git a/packages/fcl-db/tests/testspecifictbufdataset.pas b/packages/fcl-db/tests/testspecifictbufdataset.pas index a2a2775ca9..49866cb224 100644 --- a/packages/fcl-db/tests/testspecifictbufdataset.pas +++ b/packages/fcl-db/tests/testspecifictbufdataset.pas @@ -25,7 +25,9 @@ type TTestSpecificTBufDataset = class(TTestCase) private - procedure TestDataset(ABufDataset: TBufDataset); + procedure TestDataset(ABufDataset: TBufDataset; AutoInc: boolean = false); + function GetAutoIncDataset: TBufDataset; + procedure IntTestAutoIncFieldStreaming(XML: boolean); protected procedure SetUp; override; procedure TearDown; override; @@ -34,6 +36,9 @@ type procedure CreateDatasetFromFields; procedure TestOpeningNonExistingDataset; procedure TestCreationDatasetWithCalcFields; + procedure TestAutoIncField; + procedure TestAutoIncFieldStreaming; + procedure TestAutoIncFieldStreamingXML; end; implementation @@ -48,14 +53,16 @@ uses { TTestSpecificTBufDataset } -procedure TTestSpecificTBufDataset.TestDataset(ABufDataset: TBufDataset); +procedure TTestSpecificTBufDataset.TestDataset(ABufDataset: TBufDataset; + AutoInc: boolean); var i : integer; begin for i := 1 to 10 do begin ABufDataset.Append; - ABufDataset.FieldByName('ID').AsInteger := i; + if not AutoInc then + ABufDataset.FieldByName('ID').AsInteger := i; ABufDataset.FieldByName('NAME').AsString := 'TestName' + inttostr(i); ABufDataset.Post; end; @@ -69,6 +76,52 @@ begin CheckTrue(ABufDataset.EOF); end; +function TTestSpecificTBufDataset.GetAutoIncDataset: TBufDataset; +var + ds : TBufDataset; + f: TField; +begin + ds := TBufDataset.Create(nil); + F := TAutoIncField.Create(ds); + F.FieldName:='ID'; + F.DataSet:=ds; + F := TStringField.Create(ds); + F.FieldName:='NAME'; + F.DataSet:=ds; + F.Size:=50; + DS.CreateDataset; + + TestDataset(ds,True); + result := ds; +end; + +procedure TTestSpecificTBufDataset.IntTestAutoIncFieldStreaming(XML: boolean); +var + ds : TBufDataset; + fn: string; +begin + ds := GetAutoIncDataset; + fn := GetTempFileName; + if xml then + ds.SaveToFile(fn,dfXML) + else + ds.SaveToFile(fn); + DS.Close; + ds.Free; + + ds := TBufDataset.Create(nil); + ds.LoadFromFile(fn); + ds.Last; + CheckEquals(10,ds.FieldByName('Id').AsInteger); + ds.Append; + ds.FieldByName('NAME').asstring := 'Test'; + ds.Post; + CheckEquals(11,ds.FieldByName('Id').AsInteger); + ds.Free; + + DeleteFile(fn); +end; + procedure TTestSpecificTBufDataset.SetUp; begin DBConnector.StartTest; @@ -176,6 +229,25 @@ begin end; end; +procedure TTestSpecificTBufDataset.TestAutoIncField; +var + ds : TBufDataset; +begin + ds := GetAutoIncDataset; + DS.Close; + ds.Free; +end; + +procedure TTestSpecificTBufDataset.TestAutoIncFieldStreaming; +begin + IntTestAutoIncFieldStreaming(false); +end; + +procedure TTestSpecificTBufDataset.TestAutoIncFieldStreamingXML; +begin + IntTestAutoIncFieldStreaming(true); +end; + initialization {$ifdef fpc}