mORMot and Open Source friends
Check-in [68271abc82]
Not logged in
Home Documentation Forum Download Blog Donate Timeline Tickets Wiki Login

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

Overview
Comment:{3377} some fixes about dvoAllowDoubleValue proper use
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 68271abc8213256f80cb31b7fe726ff0d53a1b72
User & Date: ab 2017-02-02 10:33:16
Context
2017-02-03
08:33
{3378} new overloaded procedure GUIDToShort() check-in: b3647b5762 user: ab tags: trunk
07:28
Custmize SM exception log output by spliting a stack trace by CR check-in: 1564f836d3 user: pavel.mash tags: trunk
07:13
merge trunk to HTTPServerEvents check-in: 95c6dcf88a user: pavel.mash tags: HTTPServerEvents
2017-02-02
10:33
{3377} some fixes about dvoAllowDoubleValue proper use check-in: 68271abc82 user: ab tags: trunk
09:45
{3376} new TServiceFactoryServer.ExcludeServiceLogCustomAnswer property to reduce TSQLServiceLog.Output storage check-in: fad32d3785 user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SQLite3/mORMotMongoDB.pas. 

558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
...
583
584
585
586
587
588
589
590
591




592
593
594
595
596
597
598

    blob: RawByteString;
    info: TSQLPropInfo;
    typenfo: pointer;
    js, RecordVersionName: RawUTF8;
    MissingID: boolean;
    V: PVarData;
begin
  doc.InitJSON(JSON,[dvoValueCopiedByReference]);
  if (doc.Kind<>dvObject) and (Occasion<>soInsert) then
    raise EORMMongoDBException.CreateUTF8('%.DocFromJSON: invalid JSON context',[self]);
  if not (Occasion in [soInsert,soUpdate]) then
    raise EORMMongoDBException.CreateUTF8('Unexpected %.DocFromJSON(Occasion=%)',
      [self,ToText(Occasion)^]);
  MissingID := true;
  for i := doc.Count-1 downto 0 do // downwards for doc.Delete(i) below
................................................................................
          '%.DocFromJSON: unkwnown field name "%"',[self,doc.Names[i]]);
      doc.Names[i] := fStoredClassProps.ExternalDB.ExtFieldNames[ndx];
      info := fStoredClassProps.Props.Fields.List[ndx];
      V := @doc.Values[i];
      case V^.VType of
      varInteger:
      case info.SQLFieldType of
        sftBoolean: // doc.InitJSON/GetVariantFromJSON store 0,1 as varInteger
          Variant(V^) := boolean(V^.VInteger); // store true boolean BSON




        sftUnixTime: begin
          V^.VDate := UnixTimeToDateTime(V^.VInteger); // as MongoDB date/time
          V^.VType := varDate; // direct set to avoid unexpected EInvalidOp
        end;
      end;
      varInt64:
      case info.SQLFieldType of







|







 







|
|
>
>
>
>








558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
...
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602

    blob: RawByteString;
    info: TSQLPropInfo;
    typenfo: pointer;
    js, RecordVersionName: RawUTF8;
    MissingID: boolean;
    V: PVarData;
begin
  doc.InitJSON(JSON,[dvoValueCopiedByReference,dvoAllowDoubleValue]);
  if (doc.Kind<>dvObject) and (Occasion<>soInsert) then
    raise EORMMongoDBException.CreateUTF8('%.DocFromJSON: invalid JSON context',[self]);
  if not (Occasion in [soInsert,soUpdate]) then
    raise EORMMongoDBException.CreateUTF8('Unexpected %.DocFromJSON(Occasion=%)',
      [self,ToText(Occasion)^]);
  MissingID := true;
  for i := doc.Count-1 downto 0 do // downwards for doc.Delete(i) below
................................................................................
          '%.DocFromJSON: unkwnown field name "%"',[self,doc.Names[i]]);
      doc.Names[i] := fStoredClassProps.ExternalDB.ExtFieldNames[ndx];
      info := fStoredClassProps.Props.Fields.List[ndx];
      V := @doc.Values[i];
      case V^.VType of
      varInteger:
      case info.SQLFieldType of
        sftBoolean: begin // doc.InitJSON/GetVariantFromJSON store 0,1 as varInteger
          if V^.VInteger=0 then // normalize to boolean BSON
            V^.VBoolean := false else
            V^.VBoolean := true;
          V^.VType := varBoolean;
        end;
        sftUnixTime: begin
          V^.VDate := UnixTimeToDateTime(V^.VInteger); // as MongoDB date/time
          V^.VType := varDate; // direct set to avoid unexpected EInvalidOp
        end;
      end;
      varInt64:
      case info.SQLFieldType of

Changes to SynCommons.pas. 

39609
39610
39611
39612
39613
39614
39615
39616
39617
39618
39619
39620
39621
39622
39623
39624
39625
39626
39627
.....
39985
39986
39987
39988
39989
39990
39991


39992
39993
39994
39995
39996
39997
39998
39999
40000
40001
40002
40003
40004
40005
40006
40007
.....
40200
40201
40202
40203
40204
40205
40206
40207
40208
40209
40210
40211
40212
40213
40214

  if JSON=nil then
    exit;
  if TryCustomVariants<>nil then begin
    if dvoJSONObjectParseWithinString in TryCustomVariants^ then begin
      JSON := GotoNextNotSpace(JSON);
      if JSON^='"' then begin
        Val := GetJSONField(result,result,@wasString,EndOfObject);
        GetJSONToAnyVariant(Value,Val,EndOfObject,TryCustomVariants,false);
      end else
        GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,false);
    end else
      GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,false);
  end else begin
    Val := GetJSONField(result,result,@wasString,EndOfObject);
    GetVariantFromJSON(Val,wasString,Value,nil,AllowDouble);
  end;
  if result=nil then
    result := @NULCHAR;
end;
................................................................................
var i: integer;
    VariantType: ^TSynInvokeableVariantType;
    ToBeParsed: PUTF8Char;
    wasParsedWithinString: boolean;
begin
  if TVarData(Value).VType and VTYPE_STATIC<>0 then
    VarClear(Value);


  if EndOfObject<>nil then
    EndOfObject^ := ' ';
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if (Options=nil) or (JSON^ in ['1'..'9']) then begin // obvious simple type
    ProcessSimple(GetJSONField(JSON,JSON,@wasString,EndOfObject));
    exit;
  end;
  if dvoAllowDoubleValue in Options^ then
    AllowDouble := true; // for ProcessSimple() above
  if JSON^='"' then
    if dvoJSONObjectParseWithinString in Options^ then begin
      ToBeParsed := GetJSONField(JSON,JSON,@wasString,EndOfObject);
      EndOfObject := nil; // already set just above
      wasParsedWithinString := true;
    end else begin
      ProcessSimple(GetJSONField(JSON,JSON,@wasString,EndOfObject));
................................................................................
procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean);
begin
  // first handle any strict-JSON syntax objects or arrays into custom variants
  // (e.g. when called directly from TSQLPropInfoRTTIVariant.SetValue)
  if (TryCustomVariants<>nil) and (JSON<>nil) then
    if GotoNextNotSpace(JSON)^ in ['{','['] then begin
      GetJSONToAnyVariant(Value,JSON,nil,TryCustomVariants,false);
      exit;
    end else
    AllowDouble := dvoAllowDoubleValue in TryCustomVariants^;
  // handle simple text or numerical values
  with TVarData(Value) do begin
    if VType and VTYPE_STATIC=0 then
      VType := varEmpty else







|

|

|







 







>
>







<
<







 







|








39609
39610
39611
39612
39613
39614
39615
39616
39617
39618
39619
39620
39621
39622
39623
39624
39625
39626
39627
.....
39985
39986
39987
39988
39989
39990
39991
39992
39993
39994
39995
39996
39997
39998
39999
40000


40001
40002
40003
40004
40005
40006
40007
.....
40200
40201
40202
40203
40204
40205
40206
40207
40208
40209
40210
40211
40212
40213
40214

  if JSON=nil then
    exit;
  if TryCustomVariants<>nil then begin
    if dvoJSONObjectParseWithinString in TryCustomVariants^ then begin
      JSON := GotoNextNotSpace(JSON);
      if JSON^='"' then begin
        Val := GetJSONField(result,result,@wasString,EndOfObject);
        GetJSONToAnyVariant(Value,Val,EndOfObject,TryCustomVariants,AllowDouble);
      end else
        GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,AllowDouble);
    end else
      GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,AllowDouble);
  end else begin
    Val := GetJSONField(result,result,@wasString,EndOfObject);
    GetVariantFromJSON(Val,wasString,Value,nil,AllowDouble);
  end;
  if result=nil then
    result := @NULCHAR;
end;
................................................................................
var i: integer;
    VariantType: ^TSynInvokeableVariantType;
    ToBeParsed: PUTF8Char;
    wasParsedWithinString: boolean;
begin
  if TVarData(Value).VType and VTYPE_STATIC<>0 then
    VarClear(Value);
  if (Options<>nil) and (dvoAllowDoubleValue in Options^) then
    AllowDouble := true; // for ProcessSimple() above
  if EndOfObject<>nil then
    EndOfObject^ := ' ';
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if (Options=nil) or (JSON^ in ['1'..'9']) then begin // obvious simple type
    ProcessSimple(GetJSONField(JSON,JSON,@wasString,EndOfObject));
    exit;
  end;


  if JSON^='"' then
    if dvoJSONObjectParseWithinString in Options^ then begin
      ToBeParsed := GetJSONField(JSON,JSON,@wasString,EndOfObject);
      EndOfObject := nil; // already set just above
      wasParsedWithinString := true;
    end else begin
      ProcessSimple(GetJSONField(JSON,JSON,@wasString,EndOfObject));
................................................................................
procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean);
begin
  // first handle any strict-JSON syntax objects or arrays into custom variants
  // (e.g. when called directly from TSQLPropInfoRTTIVariant.SetValue)
  if (TryCustomVariants<>nil) and (JSON<>nil) then
    if GotoNextNotSpace(JSON)^ in ['{','['] then begin
      GetJSONToAnyVariant(Value,JSON,nil,TryCustomVariants,AllowDouble);
      exit;
    end else
    AllowDouble := dvoAllowDoubleValue in TryCustomVariants^;
  // handle simple text or numerical values
  with TVarData(Value) do begin
    if VType and VTYPE_STATIC=0 then
      VType := varEmpty else

Changes to SynMongoDB.pas. 

3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577

        // recognized TTextWriter.AddDateTime(woDateTimeWithMagic) pattern
        BSONWriteDateTime(name,ValueDateTime) else
        // will point to the in-place escaped JSON text
        BSONWriteString(name,Value,ValueLen);
    end;
  end;
  if TotalWritten>BSON_MAXDOCUMENTSIZE then
    raise EBSONException.CreateUTF8('%.BSONWriteDoc(size=%>max %)',
      [self,TotalWritten,BSON_MAXDOCUMENTSIZE]);
end;

function TBSONWriter.BSONWriteDocFromJSON(JSON: PUTF8Char; aEndOfObject: PUTF8Char;
  out Kind: TBSONElementType; DoNotTryExtendedMongoSyntax: boolean): PUTF8Char;
var ndx: cardinal;
    EndOfObject: AnsiChar;







|








3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577

        // recognized TTextWriter.AddDateTime(woDateTimeWithMagic) pattern
        BSONWriteDateTime(name,ValueDateTime) else
        // will point to the in-place escaped JSON text
        BSONWriteString(name,Value,ValueLen);
    end;
  end;
  if TotalWritten>BSON_MAXDOCUMENTSIZE then
    raise EBSONException.CreateUTF8('%.BSONWriteDoc(size=% > max=%)',
      [self,TotalWritten,BSON_MAXDOCUMENTSIZE]);
end;

function TBSONWriter.BSONWriteDocFromJSON(JSON: PUTF8Char; aEndOfObject: PUTF8Char;
  out Kind: TBSONElementType; DoNotTryExtendedMongoSyntax: boolean): PUTF8Char;
var ndx: cardinal;
    EndOfObject: AnsiChar;

Changes to SynopseCommit.inc. 

1

'1.18.3376'

|

1

'1.18.3377'

©2010-2022 Synopse Informatique