mORMot and Open Source friends
Check-in [416efd9c7d]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:{3745} enhanced TSQLPropInfo.CopyProp process of variant fields - to allow e.g. TRawUTF8DynArray mapping for mORMotDDD
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 416efd9c7d923161f438548e415e5cb2ce96f4e3
User & Date: ab 2017-07-27 10:27:43
Context
2017-07-27
15:04
{3746} renamed crcblockpas as crcblockNoSSE42 for accuracy check-in: 88f8359117 user: ab tags: trunk
10:27
{3745} enhanced TSQLPropInfo.CopyProp process of variant fields - to allow e.g. TRawUTF8DynArray mapping for mORMotDDD check-in: 416efd9c7d user: ab tags: trunk
2017-07-26
17:03
{3744} code refactoring for FPC over BSD/Darwin compilation to get rid of unneeded {$ifdef BSD}Cardinal{$endif} conditionals check-in: c94a71a3fe user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SQLite3/mORMot.pas.

21022
21023
21024
21025
21026
21027
21028

21029
21030
21031
21032
21033
21034
21035
21036
.....
21083
21084
21085
21086
21087
21088
21089



21090







21091
21092
21093
21094
21095
21096
21097
.....
24900
24901
24902
24903
24904
24905
24906

24907
24908
24909
24910
24911
24912

24913
24914
24915
24916
24917
24918
24919
.....
31271
31272
31273
31274
31275
31276
31277

31278
31279
31280
31281
31282
31283
31284
.....
31285
31286
31287
31288
31289
31290
31291

31292
31293
31294
31295
31296
31297
31298
  sftInteger, sftID, sftTID, sftRecord, sftSet, sftRecordVersion, sftSessionUserID,
  sftTimeLog, sftModTime, sftCreateTime, sftUnixTime, sftUnixMSTime:
    SetInt64(Value,result.VInt64);
  sftAnsiText, sftUTF8Text:
    SetString(RawUTF8(result.VAny),Value,StrLen(Value));
  sftBlobCustom, sftBlob:
    RawByteString(result.VAny) := BlobToTSQLRawBlob(Value);

  sftBlobDynArray, sftObject, sftVariant, sftUTF8Custom, sftNullable: begin
    if (fieldType=sftBlobDynArray) and (typeInfo<>nil) and
       (Value<>nil) and (Value^<>'[') and
       Base64MagicCheckAndDecode(Value,tmp) then
      Value := pointer(DynArrayBlobSaveJSON(typeInfo,tmp.buf)) else
    if createValueTempCopy then
      Value := tmp.Init(Value) else
      tmp.buf := nil;
................................................................................
end;

procedure TSQLPropInfo.CopyProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject);

  procedure GenericCopy;
  var tmp: RawUTF8;
      wasString: boolean;



  begin







    GetValueVar(Source,false,tmp,@wasString);
    DestInfo.SetValueVar(Dest,tmp,wasString);
  end;

var i: integer;
begin
  if (Source=nil) or (DestInfo=nil) or (Dest=nil) then
................................................................................
        if (PTypeInfo(FieldTypeInfo)^.Kind=tkEnumeration) then
          ContentTypeInfo := PTypeInfo(FieldTypeInfo)^.EnumBaseType;
      sftSet:
        if (PTypeInfo(FieldTypeInfo)^.Kind=tkSet) then
          ContentTypeInfo := PTypeInfo(FieldTypeInfo)^.SetEnumType;
      sftBlobDynArray:
        ContentTypeInfo := FieldTypeInfo;

      sftNullable: begin
        ContentTypeInfo := FieldTypeInfo;
        ContentType := NullableTypeToSQLFieldType(FieldTypeInfo);
        if ContentType=sftUnknown then
          ContentType := sftNullable;
      end;

      end;
    TableIndex := FieldTableIndex;
  end;
end;

procedure TSQLTable.SetFieldType(const FieldName: RawUTF8; FieldType: TSQLFieldType;
   FieldTypeInfo: pointer=nil; FieldSize: integer=-1);
................................................................................
  end;
  W.CancelLastComma;
  W.Add(']');
  if FieldName<>'' then
    W.Add(',');
end;


procedure TSQLRecord.ForceVariantFieldsOptions(aOptions: TDocVariantOptions);
var i: integer;
begin
  if self<>nil then
  with RecordProps do
  if sftVariant in HasTypeFields then
  for i := 0 to Fields.Count-1 do
................................................................................
    with TSQLPropInfoRTTIVariant(Fields.List[i]) do
    if (SQLFieldType=sftVariant) and InheritsFrom(TSQLPropInfoRTTIVariant) then
      if PropInfo.GetterIsField then
        with _Safe(PVariant(PropInfo.GetterAddr(self))^)^ do
          if Count>0 then
            Options := aOptions;
end;


procedure TSQLRecord.GetJSONValuesAndFree(JSON : TJSONSerializer);
begin
  if JSON<>nil then
  try
    // write the row data
    GetJSONValues(JSON);






>
|







 







>
>
>

>
>
>
>
>
>
>







 







>






>







 







>







 







>







21022
21023
21024
21025
21026
21027
21028
21029
21030
21031
21032
21033
21034
21035
21036
21037
.....
21084
21085
21086
21087
21088
21089
21090
21091
21092
21093
21094
21095
21096
21097
21098
21099
21100
21101
21102
21103
21104
21105
21106
21107
21108
.....
24911
24912
24913
24914
24915
24916
24917
24918
24919
24920
24921
24922
24923
24924
24925
24926
24927
24928
24929
24930
24931
24932
.....
31284
31285
31286
31287
31288
31289
31290
31291
31292
31293
31294
31295
31296
31297
31298
.....
31299
31300
31301
31302
31303
31304
31305
31306
31307
31308
31309
31310
31311
31312
31313
  sftInteger, sftID, sftTID, sftRecord, sftSet, sftRecordVersion, sftSessionUserID,
  sftTimeLog, sftModTime, sftCreateTime, sftUnixTime, sftUnixMSTime:
    SetInt64(Value,result.VInt64);
  sftAnsiText, sftUTF8Text:
    SetString(RawUTF8(result.VAny),Value,StrLen(Value));
  sftBlobCustom, sftBlob:
    RawByteString(result.VAny) := BlobToTSQLRawBlob(Value);
  {$ifndef NOVARIANTS}sftVariant, sftNullable,{$endif}
  sftBlobDynArray, sftObject, sftUTF8Custom: begin
    if (fieldType=sftBlobDynArray) and (typeInfo<>nil) and
       (Value<>nil) and (Value^<>'[') and
       Base64MagicCheckAndDecode(Value,tmp) then
      Value := pointer(DynArrayBlobSaveJSON(typeInfo,tmp.buf)) else
    if createValueTempCopy then
      Value := tmp.Init(Value) else
      tmp.buf := nil;
................................................................................
end;

procedure TSQLPropInfo.CopyProp(Source: TObject; DestInfo: TSQLPropInfo; Dest: TObject);

  procedure GenericCopy;
  var tmp: RawUTF8;
      wasString: boolean;
      {$ifndef NOVARIANTS}
      val: variant;
      {$endif}
  begin
    {$ifndef NOVARIANTS} // force JSON serialization, e.g. for dynamic arrays
    if (DestInfo.SQLFieldType=sftVariant) or (SQLfieldType=sftVariant) then begin
      GetVariant(Source,val);
      DestInfo.SetVariant(Dest,val);
      exit;
    end;
    {$endif}
    GetValueVar(Source,false,tmp,@wasString);
    DestInfo.SetValueVar(Dest,tmp,wasString);
  end;

var i: integer;
begin
  if (Source=nil) or (DestInfo=nil) or (Dest=nil) then
................................................................................
        if (PTypeInfo(FieldTypeInfo)^.Kind=tkEnumeration) then
          ContentTypeInfo := PTypeInfo(FieldTypeInfo)^.EnumBaseType;
      sftSet:
        if (PTypeInfo(FieldTypeInfo)^.Kind=tkSet) then
          ContentTypeInfo := PTypeInfo(FieldTypeInfo)^.SetEnumType;
      sftBlobDynArray:
        ContentTypeInfo := FieldTypeInfo;
      {$ifndef NOVARIANTS}
      sftNullable: begin
        ContentTypeInfo := FieldTypeInfo;
        ContentType := NullableTypeToSQLFieldType(FieldTypeInfo);
        if ContentType=sftUnknown then
          ContentType := sftNullable;
      end;
      {$endif}
      end;
    TableIndex := FieldTableIndex;
  end;
end;

procedure TSQLTable.SetFieldType(const FieldName: RawUTF8; FieldType: TSQLFieldType;
   FieldTypeInfo: pointer=nil; FieldSize: integer=-1);
................................................................................
  end;
  W.CancelLastComma;
  W.Add(']');
  if FieldName<>'' then
    W.Add(',');
end;

{$ifndef NOVARIANTS}
procedure TSQLRecord.ForceVariantFieldsOptions(aOptions: TDocVariantOptions);
var i: integer;
begin
  if self<>nil then
  with RecordProps do
  if sftVariant in HasTypeFields then
  for i := 0 to Fields.Count-1 do
................................................................................
    with TSQLPropInfoRTTIVariant(Fields.List[i]) do
    if (SQLFieldType=sftVariant) and InheritsFrom(TSQLPropInfoRTTIVariant) then
      if PropInfo.GetterIsField then
        with _Safe(PVariant(PropInfo.GetterAddr(self))^)^ do
          if Count>0 then
            Options := aOptions;
end;
{$endif}

procedure TSQLRecord.GetJSONValuesAndFree(JSON : TJSONSerializer);
begin
  if JSON<>nil then
  try
    // write the row data
    GetJSONValues(JSON);

Changes to SQLite3/mORMotDDD.pas.

1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
  end;
  FileFromString(code,DestinationSourceCodeFile);
end;

procedure TDDDRepositoryRestFactory.ComputeMapping;

  procedure EnsureCompatible(agg,rec: TSQLPropInfo);
  { note about T*ObjArray published fields:
      TOrder = class(TSynAutoCreateFields)
      published
        property Lines: TOrderLineObjArray
    In all cases, T*ObjArray should be accessible directly, using ObjArray*()
    wrapper functions.
    Storage at TSQLRecord level would use JSON format, i.e. a variant in the
    current implementation - you may use a plain RawUTF8 field if the on-the-fly
    conversion to/from TDocVariant appears to be a bottleneck. }
  begin
    if agg.SQLDBFieldType=rec.SQLDBFieldType then
      exit; // very same type at DB level -> OK
    if (agg.SQLFieldType=sftBlobDynArray) and
       ((agg as TSQLPropInfoRTTIDynArray).ObjArray<>nil) and
       (rec.SQLFieldType in [sftVariant,sftUTF8Text]) then
      exit; // allow T*ObjArray <-> JSON/TEXT <-> variant/RawUTF8 marshalling
    raise EDDDRepository.CreateUTF8(self,
      '% types do not match at DB level: %.%:%=% and %.%:%=%',[self,
      Aggregate,agg.Name,agg.SQLFieldRTTITypeName,agg.SQLDBFieldTypeName^,
      fTable,rec.Name,rec.SQLFieldRTTITypeName,rec.SQLDBFieldTypeName^]);
  end;

var i,ndx: integer;






|




|







<

|







1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434

1435
1436
1437
1438
1439
1440
1441
1442
1443
  end;
  FileFromString(code,DestinationSourceCodeFile);
end;

procedure TDDDRepositoryRestFactory.ComputeMapping;

  procedure EnsureCompatible(agg,rec: TSQLPropInfo);
  { note about dynamic arrays (e.g. TRawUTF8DynArray or T*ObjArray) published fields:
      TOrder = class(TSynAutoCreateFields)
      published
        property Lines: TOrderLineObjArray
    In all cases, T*ObjArray should be accessible directly, using ObjArray*()
    wrapper functions, and other dynamic arrays too.
    Storage at TSQLRecord level would use JSON format, i.e. a variant in the
    current implementation - you may use a plain RawUTF8 field if the on-the-fly
    conversion to/from TDocVariant appears to be a bottleneck. }
  begin
    if agg.SQLDBFieldType=rec.SQLDBFieldType then
      exit; // very same type at DB level -> OK
    if (agg.SQLFieldType=sftBlobDynArray) and

       (rec.SQLFieldType in [sftVariant,sftUTF8Text]) then
      exit; // allow array <-> JSON/TEXT <-> variant/RawUTF8 marshalling
    raise EDDDRepository.CreateUTF8(self,
      '% types do not match at DB level: %.%:%=% and %.%:%=%',[self,
      Aggregate,agg.Name,agg.SQLFieldRTTITypeName,agg.SQLDBFieldTypeName^,
      fTable,rec.Name,rec.SQLFieldRTTITypeName,rec.SQLDBFieldTypeName^]);
  end;

var i,ndx: integer;

Changes to SynopseCommit.inc.

1
'1.18.3744'
|
1
'1.18.3745'