From: <na...@us...> - 2009-08-15 10:38:29
|
Revision: 827 http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=827&view=rev Author: nandod Date: 2009-08-15 10:38:20 +0000 (Sat, 15 Aug 2009) Log Message: ----------- * D2009: fixed reading embedded objects in binary format. Retructured embedded object I/O in D2007 and D2009. * Added SQL statement logging for write as well as read statements. * Optimized XML output. Modified Paths: -------------- trunk/Source/Core/InstantBrokers.pas trunk/Source/Core/InstantClasses.pas trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Core/InstantBrokers.pas =================================================================== --- trunk/Source/Core/InstantBrokers.pas 2009-08-14 19:28:40 UTC (rev 826) +++ trunk/Source/Core/InstantBrokers.pas 2009-08-15 10:38:20 UTC (rev 827) @@ -267,6 +267,11 @@ procedure InternalStoreMap(AObject: TInstantObject; Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); virtual; + function CreateEmbeddedObjectInputStream(const AConnector: TInstantConnector; + const AField: TField): TStream; + function CreateEmbeddedObjectOutputStream(const AConnector: TInstantConnector): TStream; + procedure AssignEmbeddedObjectStreamToField(const AConnector: TInstantConnector; + const AStream: TStream; const AField: TField); public constructor Create(ABroker: TInstantCustomRelationalBroker); procedure DisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap; @@ -389,8 +394,8 @@ procedure WriteReferences(Attribute: TInstantReferences); virtual; procedure WriteString(Attribute: TInstantString); virtual; property DataSet: TDataset read GetDataSet write SetDataSet; - property NavigationalLinkResolvers: TObjectList read - GetNavigationalLinkResolvers; + property NavigationalLinkResolvers: TObjectList + read GetNavigationalLinkResolvers; public constructor Create(ABroker: TInstantNavigationalBroker; const ATableName: string); @@ -488,6 +493,8 @@ procedure RemovePersistentIdParam(Params: TParams); function TranslateError(AObject: TInstantObject; E: Exception): Exception; virtual; + procedure AddEmbeddedObjectOutputParam(const AConnector: TInstantConnector; + const AParams: TParams; const AParamName: string; const AStream: TStream); public constructor Create(ABroker: TInstantSQLBroker; AMap: TInstantAttributeMap); property Broker: TInstantSQLBroker read GetBroker; @@ -1430,7 +1437,7 @@ CachedStatement: TInstantStatement; begin {$IFDEF IO_STATEMENT_LOGGING} - InstantLogStatement(InstantLogStatementBefore, AStatement, AParams); + InstantLogStatement(InstantLogStatementSelect, AStatement, AParams); {$ENDIF} Result := nil; if FStatementCacheCapacity <> 0 then @@ -1739,6 +1746,58 @@ FBroker := ABroker; end; +function TInstantCustomResolver.CreateEmbeddedObjectInputStream( + const AConnector: TInstantConnector; const AField: TField): TStream; +{$IFDEF D12+} +var + LEncoding: TEncoding; +{$ENDIF} +begin + Assert(Assigned(AConnector)); + Assert(Assigned(AField)); + + {$IFDEF D12+} + if AConnector.BlobStreamFormat = sfBinary then + Result := TBytesStream.Create(AField.AsBytes) + else + begin + TEncoding.GetBufferEncoding(AField.AsBytes, LEncoding); + Result := TInstantStringStream.Create(LEncoding.GetString(AField.AsBytes)); + end; + {$ELSE} + Result := TInstantStringStream.Create(AField.AsString); + {$ENDIF} +end; + +function TInstantCustomResolver.CreateEmbeddedObjectOutputStream( + const AConnector: TInstantConnector): TStream; +begin + Assert(Assigned(AConnector)); + + {$IFDEF D12+} + if AConnector.BlobStreamFormat = sfBinary then + Result := TBytesStream.Create + else + Result := TStringStream.Create('', TEncoding.UTF8); + {$ELSE} + Result := TStringStream.Create(''); + {$ENDIF} +end; + +procedure TInstantCustomResolver.AssignEmbeddedObjectStreamToField( + const AConnector: TInstantConnector; const AStream: TStream; const AField: TField); +begin + Assert(Assigned(AConnector)); + Assert(Assigned(AStream)); + Assert(Assigned(AField)); + Assert(AField is TBlobField); + + if AConnector.BlobStreamFormat = sfBinary then + TBlobField(AField).LoadFromStream(AStream) + else + AField.AsString := (AStream as TStringStream).DataString; +end; + procedure TInstantCustomResolver.DisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo); @@ -2329,7 +2388,7 @@ procedure TInstantNavigationalResolver.ReadPart(Attribute: TInstantPart); var Field: TField; - Stream: TInstantStringStream; + Stream: TStream; PartClassName: string; ObjID: string; begin @@ -2356,7 +2415,7 @@ Field := FieldByName(Metadata.FieldName); if not FieldHasObjects(Field) then Exit; - Stream := TInstantStringStream.Create(Field.AsString); + Stream := CreateEmbeddedObjectInputStream(Connector, Field); try LoadObjectFromStream(Stream); finally @@ -2369,7 +2428,7 @@ procedure TInstantNavigationalResolver.ReadParts(Attribute: TInstantParts); var Field: TField; - Stream: TInstantStringStream; + Stream: TStream; LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do @@ -2386,7 +2445,7 @@ Field := FieldByName(Metadata.FieldName); if not FieldHasObjects(Field) then Exit; - Stream := TInstantStringStream.Create(Field.AsString); + Stream := CreateEmbeddedObjectInputStream(Connector, Field); try LoadObjectsFromStream(Stream); finally @@ -2413,7 +2472,7 @@ Attribute: TInstantReferences); var Field: TField; - Stream: TInstantStringStream; + Stream: TStream; LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do @@ -2430,7 +2489,7 @@ Field := FieldByName(Metadata.FieldName); if not FieldHasObjects(Field) then Exit; - Stream := TInstantStringStream.Create(Field.AsString); + Stream := CreateEmbeddedObjectInputStream(Connector, Field); try LoadReferencesFromStream(Stream); finally @@ -2611,7 +2670,7 @@ procedure TInstantNavigationalResolver.WritePart(Attribute: TInstantPart); var Field: TField; - Stream: TStringStream; + Stream: TStream; begin with Attribute do begin @@ -2622,16 +2681,15 @@ Value.ClassName; FieldByName(Metadata.FieldName + InstantIdFieldName).AsString := Value.Id; -// Value.ObjectStore.StoreObject(Value, caIgnore); StoreObject(Value, caIgnore); end else begin Field := FieldByName(Metadata.FieldName); - Stream := TStringStream.Create(''); + Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector); try SaveObjectToStream(Stream); - Field.AsString := Stream.DataString; + AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field); finally Stream.Free; end; @@ -2642,7 +2700,7 @@ procedure TInstantNavigationalResolver.WriteParts(Attribute: TInstantParts); var Field: TField; - Stream: TStringStream; + Stream: TStream; LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do @@ -2663,10 +2721,10 @@ else begin Field := FieldByName(Metadata.FieldName); - Stream := TStringStream.Create(''); + Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector); try SaveObjectsToStream(Stream); - Field.AsString := Stream.DataString; + AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field); finally Stream.Free; end; @@ -2689,7 +2747,7 @@ Attribute: TInstantReferences); var Field: TField; - Stream: TStringStream; + Stream: TStream; LinkDatasetResolver: TInstantNavigationalLinkResolver; begin with Attribute do @@ -2709,10 +2767,10 @@ else begin Field := FieldByName(Metadata.FieldName); - Stream := TStringStream.Create(''); + Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector); try SaveReferencesToStream(Stream); - Field.AsString := Stream.DataString; + AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field); finally Stream.Free; end; @@ -2745,6 +2803,7 @@ var FieldName: string; + (* No longer used. To be removed when things stabilize with D2009. procedure AddBlobParam(const AFieldName, Value: string); var Param: TParam; @@ -2762,6 +2821,7 @@ if Value <> '' then Param.AsMemo := Value end; + *) procedure AddBlobAttributeParam; var @@ -2864,7 +2924,7 @@ procedure AddPartAttributeParam; var - Stream: TStringStream; + Stream: TStream; Part: TInstantPart; begin if Attribute.Metadata.StorageKind = skExternal then @@ -2876,13 +2936,10 @@ end else begin - Stream := TStringStream.Create(''); + Stream := CreateEmbeddedObjectOutputStream(Broker.Connector); try (Attribute as TInstantPart).SaveObjectToStream(Stream); - if Broker.Connector.BlobStreamFormat = sfBinary then - AddBlobParam(FieldName, Stream.DataString) - else - AddMemoParam(FieldName, Stream.DataString); + AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream); finally Stream.Free; end; @@ -2891,15 +2948,12 @@ procedure AddPartsAttributeParam; var - Stream: TStringStream; + Stream: TStream; begin - Stream := TStringStream.Create(''); + Stream := CreateEmbeddedObjectOutputStream(Broker.Connector); try (Attribute as TInstantParts).SaveObjectsToStream(Stream); - if Broker.Connector.BlobStreamFormat = sfBinary then - AddBlobParam(FieldName, Stream.DataString) - else - AddMemoParam(FieldName, Stream.DataString); + AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream); finally Stream.Free; end; @@ -2917,15 +2971,12 @@ procedure AddReferencesAttributeParam; var - Stream: TStringStream; + Stream: TStream; begin - Stream := TStringStream.Create(''); + Stream := CreateEmbeddedObjectOutputStream(Broker.Connector); try (Attribute as TInstantReferences).SaveReferencesToStream(Stream); - if Broker.Connector.BlobStreamFormat = sfBinary then - AddBlobParam(FieldName, Stream.DataString) - else - AddMemoParam(FieldName, Stream.DataString); + AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream); finally Stream.Free; end; @@ -3008,6 +3059,37 @@ AddIntegerParam(Params, ConcurrencyParamName, AUpdateCount); end; +procedure TInstantSQLResolver.AddEmbeddedObjectOutputParam( + const AConnector: TInstantConnector; const AParams: TParams; + const AParamName: string; const AStream: TStream); +var + LParam: TParam; +begin + Assert(Assigned(AConnector)); + Assert(Assigned(AParams)); + Assert(AParamName <> ''); + Assert(Assigned(AStream)); + + // Look in TInstantCustomResolver.CreateEmbeddedObjectOutputStream + // to see the stream type. Change there need to be propagated here. + if AConnector.BlobStreamFormat = sfBinary then + begin + LParam := AddParam(AParams, AParamName, ftBlob); + if AStream.Size > 0 then + {$IFDEF D12+} + LParam.AsBytes := (AStream as TBytesStream).Bytes; + {$ELSE} + LParam.AsMemo := (AStream as TStringStream).DataString; + {$ENDIF} + end + else + begin + LParam := AddParam(AParams, AParamName, ftMemo); + if AStream.Size > 0 then + LParam.AsMemo := (AStream as TStringStream).DataString; + end; +end; + procedure TInstantSQLResolver.AddIdParam(Params: TParams; const ParamName, Value: string); var @@ -3062,6 +3144,9 @@ TransError: Exception; begin try + {$IFDEF IO_STATEMENT_LOGGING} + InstantLogStatement(InstantLogStatementExecute, AStatement, AParams); + {$ENDIF} Result := Broker.Execute(AStatement, AParams); Info.Success := Result >= 1; Info.Conflict := not (Info.Success or (ConflictAction = caIgnore)); @@ -3557,7 +3642,7 @@ procedure ReadPartAttribute; var - Stream: TInstantStringStream; + Stream: TStream; LPartClassName: string; LPartId: string; begin @@ -3583,8 +3668,9 @@ end else begin - Stream := TInstantStringStream.Create(ReadBlobField(DataSet, - AFieldName)); + Stream := CreateEmbeddedObjectInputStream( + (Attribute as TInstantPart).Connector, + DataSet.FieldByName(AFieldName)); try if Stream.Size = 0 then (Attribute as TInstantPart).Reset @@ -3598,7 +3684,7 @@ procedure ReadPartsAttribute; var - Stream: TInstantStringStream; + Stream: TStream; LinkResolver: TInstantSQLLinkResolver; begin if AttributeMetadata.StorageKind = skExternal then @@ -3618,7 +3704,9 @@ end else begin - Stream := TInstantStringStream.Create(ReadBlobField(DataSet, AFieldName)); + Stream := CreateEmbeddedObjectInputStream( + (Attribute as TInstantParts).Connector, + DataSet.FieldByName(AFieldName)); try if Stream.Size = 0 then (Attribute as TInstantParts).Reset @@ -3639,7 +3727,7 @@ procedure ReadReferencesAttribute; var - Stream: TInstantStringStream; + Stream: TStream; LinkResolver: TInstantSQLLinkResolver; begin if AttributeMetadata.StorageKind = skExternal then @@ -3659,7 +3747,9 @@ end else begin - Stream := TInstantStringStream.Create(ReadBlobField(DataSet, AFieldName)); + Stream := CreateEmbeddedObjectInputStream( + (Attribute as TInstantReferences).Connector, + DataSet.FieldByName(AFieldName)); try if Stream.Size = 0 then (Attribute as TInstantReferences).Reset @@ -3728,7 +3818,7 @@ function TInstantSQLResolver.ReadBlobField(DataSet: TDataSet; const FieldName: string): string; begin - Result := DataSet.FieldByName(FieldName).AsString + Result := DataSet.FieldByName(FieldName).AsString; end; function TInstantSQLResolver.ReadBooleanField(DataSet: TDataSet; Modified: trunk/Source/Core/InstantClasses.pas =================================================================== --- trunk/Source/Core/InstantClasses.pas 2009-08-14 19:28:40 UTC (rev 826) +++ trunk/Source/Core/InstantClasses.pas 2009-08-15 10:38:20 UTC (rev 827) @@ -1465,7 +1465,9 @@ I: Integer; Esc: string; C: Char; + LString: string; begin + LString := ''; for I := 1 to Length(Data) do begin C := Data[I]; @@ -1484,11 +1486,12 @@ Esc := 'gt'; end; Esc := Format(EscStr, [Esc]); - WriteString(Esc); + LString := LString + EscStr; end else - WriteString(C); + LString := LString + C; end; + WriteString(LString); FLastToken := xtData; end; Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2009-08-14 19:28:40 UTC (rev 826) +++ trunk/Source/Core/InstantPersistence.pas 2009-08-15 10:38:20 UTC (rev 827) @@ -446,8 +446,8 @@ function GetStream: TMemoryStream; property Stream: TMemoryStream read GetStream; protected - function GetValue: AnsiString; virtual; - procedure SetValue(const AValue: AnsiString); virtual; + function GetValue: string; virtual; + procedure SetValue(const AValue: string); virtual; class function AttributeType: TInstantAttributeType; override; function GetAsString: string; override; function GetAsVariant: Variant; override; @@ -472,7 +472,7 @@ function WriteBuffer(const Buffer; Position, Count: Integer): Integer; property Size: Integer read GetSize; published - property Value: AnsiString read GetValue write SetValue; + property Value: string read GetValue write SetValue; end; TInstantMemo = class(TInstantBlob) @@ -3485,12 +3485,15 @@ Result := FStream; end; -function TInstantBlob.GetValue: AnsiString; +function TInstantBlob.GetValue: string; +var + LValue: AnsiString; begin if Size > 0 then begin - SetLength(Result, Size div SizeOf(AnsiChar)); - Read(Result[1], 0, Size); + SetLength(LValue, Size div SizeOf(AnsiChar)); + Read(LValue[1], 0, Size); + Result := string(LValue); end else Result := ''; @@ -3568,15 +3571,17 @@ end; end; -procedure TInstantBlob.SetValue(const AValue: AnsiString); +procedure TInstantBlob.SetValue(const AValue: string); var L: Integer; + LValue: AnsiString; begin - L := Length(AValue) * SizeOf(AnsiChar); + LValue := AnsiString(AValue); + L := Length(LValue) * SizeOf(AnsiChar); if L > 0 then begin Stream.Clear; - WriteBuffer(AValue[1], 0, L); + WriteBuffer(LValue[1], 0, L); Stream.Size := L; end else @@ -4433,9 +4438,11 @@ begin MemoryStream := TMemoryStream.Create; try - //CB: I don't know why MS-SQL via ADO or via DBX returns a stream with wrong size (+1) - //so I've changed this test adding -1 (for other brokers this is not a problem) - while AStream.Position < AStream.Size -1 do + // After reading the last object, the XML stream may still contain a few + // bytes for the final line break (in case the XML cose is beautified), + // so we go ahead and read another object ony if there's more bytes in the + // buffer. + while AStream.Position < AStream.Size - (Length(sLineBreak) * SizeOf(Char)) do begin MemoryStream.Clear; InstantObjectTextToBinary(AStream, MemoryStream); |