-
-
Notifications
You must be signed in to change notification settings - Fork 141
/
Copy pathmormot.db.core.pas
4227 lines (3844 loc) · 137 KB
/
mormot.db.core.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/// Database Framework Core Types and Classes
// - this unit is a part of the Open Source Synopse mORMot framework 2,
// licensed under a MPL/GPL/LGPL three license - see LICENSE.md
unit mormot.db.core;
{
*****************************************************************************
Shared Types and Definitions for Database Access
- Shared Database Fields and Values Definitions
- Nullable Values Stored as Variant
- Date/Time SQL encoding
- SQL Parameters Inlining and Processing
- TResultsWriter Specialized for Database Export
- TSelectStatement SQL SELECT Parser
- JSON Object Decoder and SQL Generation
- TID Processing Functions
This unit is used by both mormot.db.* units and mormot.orm.* units.
*****************************************************************************
}
interface
{$I ..\mormot.defines.inc}
uses
sysutils,
classes,
variants,
mormot.core.base,
mormot.core.os,
mormot.core.unicode,
mormot.core.text,
mormot.core.datetime,
mormot.core.buffers,
mormot.core.data,
mormot.core.variants,
mormot.core.rtti,
mormot.core.json;
{ ************ Shared Database Fields and Values Definitions }
const
{$undef MAX_SQLFIELDS_64}
/// maximum number of fields in a database Table
// - default is 64, but can be set to 64, 128, 192 or 256
// adding one MAX_SQLFIELDS_128, MAX_SQLFIELDS_192 or MAX_SQLFIELDS_256
// conditional directive for your project
// - this constant is used internally to optimize memory usage in the
// generated asm code, and statically allocate some arrays for better speed
// - note that due to compiler restriction, 256 is the maximum value
// (this is the maximum number of items in a Delphi/FPC set)
{$ifdef MAX_SQLFIELDS_128}
MAX_SQLFIELDS = 128;
{$else}
{$ifdef MAX_SQLFIELDS_192}
MAX_SQLFIELDS = 192;
{$else}
{$ifdef MAX_SQLFIELDS_256}
MAX_SQLFIELDS = 256;
{$else}
MAX_SQLFIELDS = 64;
{$define MAX_SQLFIELDS_64}
{$endif MAX_SQLFIELDS_256}
{$endif MAX_SQLFIELDS_192}
{$endif MAX_SQLFIELDS_128}
/// sometimes, the ID field is external to the bits set
MAX_SQLFIELDS_INCLUDINGID = MAX_SQLFIELDS + 1;
/// maximum number of bound parameters to a SQLite3 statement
// - empirical value, used e.g. for mormot.orm.sqlite3 Batch multi-insert
// - matches DB_PARAMSMAX[dSQLite] as defined in mormot.db.sql
// - the theoritical limit equals 999, but this number seems good enough
MAX_SQLPARAMS = 500;
type
/// the exception class raised by this unit
ESynDBException = class(ESynException);
/// handled field/parameter/column types for abstract database access
// - this will map JSON-compatible low-level database-level access types, not
// high-level object pascal types as TOrmFieldType defined in
// mormot.orm.core.pas
// - it does not map either all potential types as defined in DB.pas (which
// are there for compatibility with old RDBMS, and are not abstract enough)
// - those types can be mapped to standard SQLite3 generic types, i.e.
// NULL, INTEGER, REAL, TEXT, BLOB (with the addition of a ftCurrency and
// ftDate type, for better support of most DB engines)
// see @http://www.sqlite.org/datatype3.html
// - the only string type handled here uses UTF-8 encoding (implemented using
// our RawUtf8 type), for full Unicode process on all compilers and targets
TSqlDBFieldType = (
ftUnknown,
ftNull,
ftInt64,
ftDouble,
ftCurrency,
ftDate,
ftUtf8,
ftBlob);
/// set of field/parameter/column types for abstract database access
TSqlDBFieldTypes = set of TSqlDBFieldType;
/// array of field/parameter/column types for abstract database access
TSqlDBFieldTypeDynArray = array of TSqlDBFieldType;
/// array of field/parameter/column types for abstract database access
// - this array as a fixed size, ready to handle up to MAX_SQLFIELDS items
TSqlDBFieldTypeArray = array[0..MAX_SQLFIELDS - 1] of TSqlDBFieldType;
PSqlDBFieldTypeArray = ^TSqlDBFieldTypeArray;
/// how TSqlVar may be processed
// - by default, ftDate will use seconds resolution unless svoDateWithMS is set
TSqlVarOption = (
svoDateWithMS);
/// defines how TSqlVar may be processed
TSqlVarOptions = set of TSqlVarOption;
/// memory structure used for database values by reference storage
// - used mainly by mormot.db.sql, mormot.orm.sql and mormot.orm.sqlite3 units
// - defines only TSqlDBFieldType data types (similar to those handled by
// SQLite3, with the addition of ftCurrency and ftDate)
// - cleaner/lighter dedicated type than TValue or variant/TVarData, strong
// enough to be marshalled as JSON content
// - variable-length data (e.g. UTF-8 text or binary BLOB) are never stored
// within this record, but VText/VBlob will point to an external (temporary)
// memory buffer
// - date/time is stored as ISO-8601 text (with milliseconds if svoDateWithMS
// option is set and the database supports it), and currency as double or BCD
// in most databases
TSqlVar = record
/// how this value should be processed
Options: TSqlVarOptions;
/// the type of the value stored
case VType: TSqlDBFieldType of
ftInt64: (
VInt64: Int64);
ftDouble: (
VDouble: double);
ftDate: (
VDateTime: TDateTime);
ftCurrency: (
VCurrency: currency);
ftUtf8: (
VText: PUtf8Char);
ftBlob: (
VBlob: pointer;
VBlobLen: integer)
end;
/// dynamic array of database values by reference storage
TSqlVarDynArray = array of TSqlVar;
/// used to store bit set for all available fields in a Table
// - with current MAX_SQLFIELDS value, 64 bits uses 8 bytes of memory
// - see also IsZero() and IsEqual() functions
// - you can also use ALL_FIELDS as defined in this unit
TFieldBits = set of 0..MAX_SQLFIELDS - 1;
/// points to a bit set used for all available fields in a Table
PFieldBits = ^TFieldBits;
/// the integer type used to store a field index in a Table
// - the ID/RowID field is commonly set as -1, so the values should be signed
{$ifdef MAX_SQLFIELDS_64}
// - default MAX_SQLFIELDS = 64 could use ShortInt (-128..127) range
TFieldIndex = ShortInt;
{$else}
// - MAX_SQLFIELDS may be up to 256, so define SmallInt range (-32768..32767)
TFieldIndex = SmallInt;
{$endif MAX_SQLFIELDS_64}
/// used to store field indexes in a Table
// - similar to TFieldBits, but allowing to store the proper order
TFieldIndexDynArray = array of TFieldIndex;
const
/// TSqlDBFieldType kind of columns which have a fixed width
FIXEDLENGTH_SQLDBFIELDTYPE =
[ftInt64, ftDouble, ftCurrency, ftDate];
/// conversion matrix from TSqlDBFieldType into VCL/LCL variant type
// - will use varSynUnicode to enhance Delphi and Windows compatibility
MAP_FIELDTYPE2VARTYPE: array[TSqlDBFieldType] of Word = (
varEmpty, // ftUnknown
varNull, // ftNull
varInt64, // ftInt64
varDouble, // ftDouble
varCurrency, // ftCurrency
varDate, // ftDate
varSynUnicode, // ftUtf8
varString); // ftBlob
/// retrieve the text of a given Database field type enumeration
// - see also TSqlDBFieldTypeToString() function
function ToText(Field: TSqlDBFieldType): PShortString; overload;
/// retrieve the ready-to-be displayed text of a given Database field
// type enumeration
function TSqlDBFieldTypeToString(aType: TSqlDBFieldType): TShort16;
/// returns TRUE if no bit inside this TFieldBits is set
// - is optimized for 64, 128, 192 and 256 max bits count (i.e. MAX_SQLFIELDS)
// - will work also with any other value
function IsZero(const Fields: TFieldBits): boolean; overload;
{$ifdef HASINLINE}inline;{$endif}
/// fast comparison of two TFieldBits values
// - is optimized for 64, 128, 192 and 256 max bits count (i.e. MAX_SQLFIELDS)
// - will work also with any other value
function IsEqual(const A, B: TFieldBits): boolean; overload;
{$ifdef HASINLINE}inline;{$endif}
/// return TRUE if Fields equals ALL_FIELDS constant
function IsAllFields(const Fields: TFieldBits): boolean;
{$ifdef HASINLINE}inline;{$endif}
/// faster alternative to "byte(Index) in Fields" expression
// - warning: no Index range check is done
// - similar to GetBitPtr(), but optimized for default MAX_SQLFIELDS=64
function FieldBitGet(const Fields: TFieldBits; Index: PtrUInt): boolean;
{$ifdef HASINLINE}inline;{$endif}
/// faster alternative to "include(Fields, Index)" expression
// - warning: no Index range check is done
procedure FieldBitSet(var Fields: TFieldBits; Index: PtrUInt);
{$ifdef HASINLINE}inline;{$endif}
/// faster alternative to "GetBitsCount(Fields, MaxFIelds)" expression
function FieldBitCount(const Fields: TFieldBits; MaxFields: integer = MAX_SQLFIELDS): PtrInt;
{$ifdef HASINLINE}inline;{$endif}
/// fast initialize a TFieldBits with 0
// - is optimized for 64, 128, 192 and 256 max bits count (i.e. MAX_SQLFIELDS)
// - will work also with any other value
procedure FillZero(var Fields: TFieldBits); overload;
{$ifdef HASINLINE}inline;{$endif}
var
/// some pre-allocated arrays used by FieldBitsToIndex(ALL_FIELDS)
MAX_SQLFIELDS_INDEX: array[0 .. MAX_SQLFIELDS] of TFieldIndexDynArray;
/// convert a TFieldBits set of bits into an array of integers
procedure FieldBitsToIndex(const Fields: TFieldBits;
out Index: TFieldIndexDynArray; MaxLength: PtrInt = MAX_SQLFIELDS); overload;
/// convert a TFieldBits set of bits into an array of integers
function FieldBitsToIndex(const Fields: TFieldBits;
MaxLength: PtrInt = MAX_SQLFIELDS): TFieldIndexDynArray; overload;
{$ifdef HASINLINE}inline;{$endif}
/// add a field index to an array of field indexes
// - returns the index in Indexes[] of the newly appended Field value
function AddFieldIndex(var Indexes: TFieldIndexDynArray; Field: integer): PtrInt;
/// convert an array of field indexes into a TFieldBits set of bits
procedure FieldIndexToBits(const Index: TFieldIndexDynArray;
out Fields: TFieldBits); overload;
/// search a field index in an array of field indexes
// - returns the index in Indexes[] of the given Field value, -1 if not found
function SearchFieldIndex(var Indexes: TFieldIndexDynArray; Field: integer): PtrInt;
/// convert an array of field indexes into a TFieldBits set of bits
function FieldIndexToBits(const Index: TFieldIndexDynArray): TFieldBits; overload;
{$ifdef HASINLINE}inline;{$endif}
/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowID(FieldName: PUtf8Char): boolean;
{$ifdef HASINLINE}inline;{$endif} overload;
/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowID(FieldName: PUtf8Char; FieldLen: integer): boolean;
{$ifdef HASINLINE}inline;{$endif} overload;
/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowIDShort(const FieldName: ShortString): boolean;
{$ifdef HASINLINE}inline;{$endif} overload;
/// returns the stored size of a TSqlVar database value
// - only returns VBlobLen / StrLen(VText) size, 0 otherwise
function SqlVarLength(const Value: TSqlVar): integer;
/// convert any Variant into a database value
// - ftBlob kind won't be handled by this function
// - complex variant types would be converted into ftUtf8 JSON object/array
procedure VariantToSqlVar(const Input: variant; var temp: RawByteString;
var Output: TSqlVar);
/// convert any Variant into a value encoded as with :(..:) inlined parameters
// in FormatUtf8(Format,Args,Params)
// - will transform into a UTF-8, between double quotes for string values
procedure VariantToInlineValue(const V: Variant; var result: RawUtf8);
/// guess the correct TSqlDBFieldType from a raw variant type
// - map most TVarData.VType into ftInt64/ftDouble/ftDate/ftCurrency/ftUnknown
function VariantVTypeToSqlDBFieldType(VType: cardinal): TSqlDBFieldType;
/// guess the correct TSqlDBFieldType from a variant value
// - in addition to VariantVTypeToSqlDBFieldType(), will recognize a ftBlob
// from a JSON_BASE64_MAGIC value prefix
function VariantTypeToSqlDBFieldType(const V: Variant): TSqlDBFieldType;
{$ifdef HASINLINE}inline;{$endif}
/// guess the correct TSqlDBFieldType from the UTF-8 representation of a value
// - won't recognize ftDate nor ftUtf8 prefixes, just TextToVariantNumberType()
function TextToSqlDBFieldType(json: PUtf8Char): TSqlDBFieldType;
type
/// SQL Query comparison operators
// - used e.g. by CompareOperator() functions in mormot.orm.storage.pas
TSqlCompareOperator = (
soEqualTo,
soNotEqualTo,
soLessThan,
soLessThanOrEqualTo,
soGreaterThan,
soGreaterThanOrEqualTo,
soBeginWith,
soContains,
soSoundsLikeEnglish,
soSoundsLikeFrench,
soSoundsLikeSpanish);
const
/// special TFieldBits value containing all field bits set to 1
// - see also IsAllFields() wrapper function
ALL_FIELDS: TFieldBits = [0 .. MAX_SQLFIELDS - 1];
/// convert identified field types into high-level ORM types
// - as will be implemented in TOrm classes
SQLDBFIELDTYPE_TO_DELPHITYPE: array[TSqlDBFieldType] of RawUtf8 = (
'???', // ftUnknown
'???', // ftNull
'Int64', // ftInt64
'Double', // ftDouble
'Currency', // ftCurrency
'TDateTime', // ftDate
'RawUtf8', // ftUtf8
'RawBlob'); // ftBlob
/// return either 'ID' or RowID'
ID_SHORT: array[{RowID=}boolean] of string[7] = ('ID', 'RowID');
var
/// contains 'ID' as UTF-8 text with positive RefCnt (avoid const realloc)
ID_TXT: RawUtf8;
/// contains 'RowID' as UTF-8 text with positive RefCnt (avoid const realloc)
ROWID_TXT: RawUtf8;
function ToText(op: TSqlCompareOperator): PShortString; overload;
type
/// thread-safe sequence used to internally store TLastError message
TLastErrorID = integer;
/// allow to manage an Error messages list from IDs - typically per thread
// - used e.g. with a TLastErrorID threadvar for SetDbError/GetDbError
// since we can't create any string/RawUtf8 threadvar
{$ifdef USERECORDWITHMETHODS}
TLastError = record
{$else}
TLastError = object
{$endif USERECORDWITHMETHODS}
public
/// make the internal storage thread-safe
Safe: TLightLock;
/// the latest thread safe generated ID
CurrentID: TLastErrorID;
/// the current index in Seq[] and Msg[] arrays
CurrentIndex: integer;
/// store the TLastErrorID values
Seq: TIntegerDynArray;
/// store the UTF-8 Message values
Msg: TRawUtf8DynArray;
/// append a new UTF-8 message to the internal list, returning its ID
function NewMsg(const text: RawUtf8): TLastErrorID;
/// get the UTF-8 message associated to a given ID
function GetMsg(id: TLastErrorID; out text: RawUtf8): boolean;
/// modify the number of items stored in Seq[] and Msg[]
// - by default, NewMsg() will allocate space for up to 256 errors
// - supplied max value will be rounded up to the next power of two <= 1024
procedure SetCapacity(max: integer);
end;
/// set a database error message for the current thread
// - using an internal TLastError store and an associated TLastErrorID threadvar
// since we can't create any string/RawUtf8 threadvar
procedure SetDbError(const text: RawUtf8); overload;
/// set a database error message for the current thread from an exception
// - could be used when E was not created via CreateU/CreateUtf8/RaiseUtf8
procedure SetDbError(E: Exception); overload;
/// unset the error message for the current thread
procedure ClearDbError;
/// get the error message assigned by SetDbError() for the current thread
// - e.g. after any raise ESqlDBException.CreateUtf8
function GetDbError: RawUtf8;
/// quickly check if there is an error message for the current thread
function HasDbError: boolean;
type
/// abstract DB-oriented exception class
// - CreateUtf8() will also call SetDbError() with the resulting message text
ECoreDBException = class(ESynException)
protected
// internal method called by the constructor when fMessageUtf8 was just set
procedure CreateAfterSetMessageUtf8; override;
end;
// backward compatibility types redirections
{$ifndef PUREMORMOT2}
type
TSqlFieldBits = TFieldBits;
PSqlFieldBits = PFieldBits;
TSqlFieldIndex = TFieldIndex;
TSqlFieldIndexDynArray = TFieldIndexDynArray;
{$endif PUREMORMOT2}
{ ************ Nullable Values Stored as Variant }
type
/// define a variant published property as a nullable integer
// - either a varNull or a varInt64 value will be stored in the variant
// - either a NULL or an INTEGER value will be stored in the database
// - the property should be defined as such:
// ! property Int: TNullableInteger read fInt write fInt;
TNullableInteger = type variant;
/// define a variant published property as a nullable boolean
// - either a varNull or a varBoolean value will be stored in the variant
// - either a NULL or a 0/1 INTEGER value will be stored in the database
// - the property should be defined as such:
// ! property Bool: TNullableBoolean read fBool write fBool;
TNullableBoolean = type variant;
/// define a variant published property as a nullable floating point value
// - either a varNull or a varDouble value will be stored in the variant
// - either a NULL or a FLOAT value will be stored in the database
// - the property should be defined as such:
// ! property Flt: TNullableFloat read fFlt write fFlt;
TNullableFloat = type variant;
/// define a variant published property as a nullable decimal value
// - either a varNull or a varCurrency value will be stored in the variant
// - either a NULL or a FLOAT value will be stored in the database
// - the property should be defined as such:
// ! property Cur: TNullableCurrency read fCur write fCur;
TNullableCurrency = type variant;
/// define a variant published property as a nullable date/time value
// - either a varNull or a varDate value will be stored in the variant
// - either a NULL or a ISO-8601 TEXT value will be stored in the database
// - the property should be defined as such:
// ! property Dat: TNullableDateTime read fDat write fDat;
TNullableDateTime = type variant;
/// define a variant published property as a nullable timestamp value
// - either a varNull or a varInt64 value will be stored in the variant
// - either a NULL or a TTimeLog INTEGER value will be stored in the database
// - the property should be defined as such:
// ! property Tim: TNullableTimrency read fTim write fTim;
TNullableTimeLog = type variant;
/// define a variant published property as a nullable UTF-8 encoded text
// - either a varNull or varString (RawUtf8) will be stored in the variant
// - either a NULL or a TEXT value will be stored in the database
// - the property should be defined as such:
// ! property Txt: TNullableUtf8Text read fTxt write fTxt;
// or for a fixed-width VARCHAR (in external databases), here of 32 max chars:
// ! property Txt: TNullableUtf8Text index 32 read fTxt write fTxt;
// - warning: prior to Delphi 2009, since the variant will be stored as
// RawUtf8 internally, you should not use directly the field value as a
// RTL string=AnsiString like string(aField) but use VariantToString(aField)
TNullableUtf8Text = type variant;
/// can identify the TNullable* supported variant types
// - as used by NullableVariantType()
TNullableVariantType = (
nvtNone,
nvtInteger,
nvtBoolean,
nvtFloat,
nvtCurrency,
nvtDateTime,
nvtTimeLog,
nvtUtf8Text);
/// detect a TypeInfo(TNullable*) RTTI pointer to nullable variant types
function NullableVariantType(info: PRttiInfo): TNullableVariantType;
var
/// a nullable integer value containing null
NullableIntegerNull: TNullableInteger absolute NullVarData;
/// creates a nullable integer value from a supplied constant
// - FPC does not allow direct assignment to a TNullableInteger = type variant
// variable: use this function to circumvent it
function NullableInteger(const Value: Int64): TNullableInteger;
{$ifdef HASINLINE}inline;{$endif}
/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - FPC VarIsNull() seems buggy with varByRef variants, and does not allow
// direct transtyping from a TNullableInteger = type variant variable: use this
// function to circumvent those limitations
function NullableIntegerIsEmptyOrNull(const V: TNullableInteger): boolean;
/// check if a TNullableInteger is null, or return its value
// - returns FALSE if V is null or empty, or TRUE and set the integer value
function NullableIntegerToValue(const V: TNullableInteger;
out Value: Int64): boolean; overload;
/// check if a TNullableInteger is null, or return its value
// - returns 0 if V is null or empty, or the stored integer value
function NullableIntegerToValue(const V: TNullableInteger): Int64;
overload; {$ifdef HASINLINE}inline;{$endif}
var
/// a nullable boolean value containing null
NullableBooleanNull: TNullableBoolean absolute NullVarData;
/// creates a nullable boolean value from a supplied constant
// - FPC does not allow direct assignment to a TNullableBoolean = type variant
// variable: use this function to circumvent it
function NullableBoolean(Value: boolean): TNullableBoolean;
{$ifdef HASINLINE}inline;{$endif}
/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - FPC VarIsNull() seems buggy with varByRef variants, and does not allow
// direct transtyping from a TNullableBoolean = type variant variant: use this
// function to circumvent those limitations
function NullableBooleanIsEmptyOrNull(const V: TNullableBoolean): boolean;
/// check if a TNullableBoolean is null, or return its value
// - returns FALSE if V is null or empty, or TRUE and set the boolean value
function NullableBooleanToValue(const V: TNullableBoolean;
out Value: boolean): boolean; overload;
/// check if a TNullableBoolean is null, or return its value
// - returns false if V is null or empty, or the stored boolean value
function NullableBooleanToValue(const V: TNullableBoolean): boolean;
overload; {$ifdef HASINLINE}inline;{$endif}
var
/// a nullable float value containing null
NullableFloatNull: TNullableFloat absolute NullVarData;
/// creates a nullable floating-point value from a supplied constant
// - FPC does not allow direct assignment to a TNullableFloat = type variant
// variable: use this function to circumvent it
function NullableFloat(const Value: double): TNullableFloat;
{$ifdef HASINLINE}inline;{$endif}
/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - FPC VarIsNull() seems buggy with varByRef variants, and does not allow
// direct transtyping from a TNullableFloat = type variant variable: use this
// function to circumvent those limitations
function NullableFloatIsEmptyOrNull(const V: TNullableFloat): boolean;
/// check if a TNullableFloat is null, or return its value
// - returns FALSE if V is null or empty, or TRUE and set the Float value
function NullableFloatToValue(const V: TNullableFloat;
out Value: double): boolean; overload;
/// check if a TNullableFloat is null, or return its value
// - returns 0 if V is null or empty, or the stored Float value
function NullableFloatToValue(const V: TNullableFloat): double;
overload; {$ifdef HASINLINE}inline;{$endif}
var
/// a nullable currency value containing null
NullableCurrencyNull: TNullableCurrency absolute NullVarData;
/// creates a nullable Currency value from a supplied currency value
// - we defined the currency type to circumvent FPC cross-platform issues
// with currency values;
// - warning: FPC does not support assignment to a TNullableCurrency = type variant
// variable: use this function to circumvent it
function NullableCurrency(const Value: currency): TNullableCurrency;
{$ifdef HASINLINE}inline;{$endif}
/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - FPC VarIsNull() seems buggy with varByRef variants, and does not allow
// direct transtyping from a TNullableCurrency = type variant variable: use this
// function to circumvent those limitations
function NullableCurrencyIsEmptyOrNull(const V: TNullableCurrency): boolean;
/// check if a TNullableCurrency is null, or return its value
// - returns FALSE if V is null or empty, or TRUE and set the Currency value
// - we defined the currency type to circumvent FPC cross-platform issues
// with currency values;
function NullableCurrencyToValue(const V: TNullableCurrency;
out Value: currency): boolean; overload;
/// check if a TNullableCurrency is null, or return its value
// - returns 0 if V is null or empty, or the stored Currency value
// - we defined the currency type to circumvent FPC cross-platform issues
// with currency values;
function NullableCurrencyToValue(const V: TNullableCurrency): currency;
overload; {$ifdef HASINLINE}inline;{$endif}
var
/// a nullable TDateTime value containing null
NullableDateTimeNull: TNullableDateTime absolute NullVarData;
/// creates a nullable TDateTime value from a supplied constant
// - FPC does not allow direct assignment to a TNullableDateTime = type variant
// variable: use this function to circumvent it
function NullableDateTime(const Value: TDateTime): TNullableDateTime;
{$ifdef HASINLINE}inline;{$endif}
/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - FPC VarIsNull() seems buggy with varByRef variants, and does not allow
// direct transtyping from a TNullableDateTime = type variant variable: use this
// function to circumvent those limitations
function NullableDateTimeIsEmptyOrNull(const V: TNullableDateTime): boolean;
/// check if a TNullableDateTime is null, or return its value
// - returns FALSE if V is null or empty, or TRUE and set the DateTime value
function NullableDateTimeToValue(const V: TNullableDateTime;
out Value: TDateTime): boolean; overload;
/// check if a TNullableDateTime is null, or return its value
// - returns 0 if V is null or empty, or the stored DateTime value
function NullableDateTimeToValue(const V: TNullableDateTime): TDateTime;
overload; {$ifdef HASINLINE}inline;{$endif}
var
/// a nullable TTimeLog value containing null
NullableTimeLogNull: TNullableTimeLog absolute NullVarData;
/// creates a nullable TTimeLog value from a supplied constant
// - FPC does not allow direct assignment to a TNullableTimeLog = type variant
// variable: use this function to circumvent it
function NullableTimeLog(const Value: TTimeLog): TNullableTimeLog;
{$ifdef HASINLINE}inline;{$endif}
/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - FPC VarIsNull() seems buggy with varByRef variants, and does not allow
// direct transtyping from a TNullableTimeLog = type variant variable: use this
// function to circumvent those limitations
function NullableTimeLogIsEmptyOrNull(const V: TNullableTimeLog): boolean;
/// check if a TNullableTimeLog is null, or return its value
// - returns FALSE if V is null or empty, or TRUE and set the TimeLog value
function NullableTimeLogToValue(const V: TNullableTimeLog;
out Value: TTimeLog): boolean; overload;
/// check if a TNullableTimeLog is null, or return its value
// - returns 0 if V is null or empty, or the stored TimeLog value
function NullableTimeLogToValue(const V: TNullableTimeLog): TTimeLog;
overload; {$ifdef HASINLINE}inline;{$endif}
var
/// a nullable UTF-8 encoded text value containing null
NullableUtf8TextNull: TNullableUtf8Text absolute NullVarData;
/// creates a nullable UTF-8 encoded text value from a supplied constant
// - FPC does not allow direct assignment to a TNullableUtf8 = type variant
// variable: use this function to circumvent it
function NullableUtf8Text(const Value: RawUtf8): TNullableUtf8Text;
/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - FPC VarIsNull() seems buggy with varByRef variants, and does not allow
// direct transtyping from a TNullableUtf8Text = type variant variable: use this
// function to circumvent those limitations
function NullableUtf8TextIsEmptyOrNull(const V: TNullableUtf8Text): boolean;
/// check if a TNullableUtf8Text is null, or return its value
// - returns FALSE if V is null or empty, or TRUE and set the Utf8Text value
function NullableUtf8TextToValue(const V: TNullableUtf8Text;
out Value: RawUtf8): boolean; overload;
/// check if a TNullableUtf8Text is null, or return its value
// - returns '' if V is null or empty, or the stored UTF-8 encoded text value
function NullableUtf8TextToValue(const V: TNullableUtf8Text): RawUtf8; overload;
{ ************ Date/Time SQL encoding }
/// convert a date to a ISO-8601 string format for SQL '?' inlined parameters
// - will return the date encoded as '\uFFF1YYYY-MM-DD' - therefore
// ':("\uFFF12012-05-04"):' pattern will be recognized as a oftDateTime
// inline parameter by the TExtractInlineParameters decoder
// (JSON_SQLDATE_MAGIC_C will be used as prefix to create '\uFFF1...' pattern)
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum=?',[DateToSql(EncodeDate(2012,5,4))]);
function DateToSql(Date: TDateTime): RawUtf8; overload;
/// convert a date to a ISO-8601 string format for SQL '?' inlined parameters
// - will return the date encoded as '\uFFF1YYYY-MM-DD' - therefore
// ':("\uFFF12012-05-04"):' pattern will be recognized as a oftDateTime
// inline parameter by the TExtractInlineParameters decoder
// (JSON_SQLDATE_MAGIC_C will be used as prefix to create '\uFFF1...' pattern)
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum=?',[DateToSql(2012,5,4)]);
function DateToSql(Year, Month, Day: cardinal): RawUtf8; overload;
/// convert a date/time to a ISO-8601 string format for SQL '?' inlined parameters
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as '\uFFF1YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as '\uFFF1Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as '\uFFF1YYYY-MM-DDThh:mm:ss'
// (JSON_SQLDATE_MAGIC_C will be used as prefix to create '\uFFF1...' pattern)
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum<=?',[DateTimeToSql(Now)]);
// - see TimeLogToSql() if you are using TTimeLog/TModTime/TCreateTime values
function DateTimeToSql(DT: TDateTime; WithMS: boolean = false): RawUtf8;
/// decode a SQL '?' inlined parameter (i.e. with JSON_BASE64_MAGIC_C prefix)
// - as generated by DateToSql/DateTimeToSql/TimeLogToSql functions
function SqlToDateTime(const ParamValueWithMagic: RawUtf8): TDateTime;
/// convert a TTimeLog value into a ISO-8601 string format for SQL '?' inlined
// parameters
// - handle TTimeLog bit-encoded Int64 format
// - follows the same pattern as DateToSql or DateTimeToSql functions, i.e.
// will return the date or time encoded as '\uFFF1YYYY-MM-DDThh:mm:ss' -
// therefore ':("\uFFF12012-05-04T20:12:13"):' pattern will be recognized as a
// oftDateTime inline parameter by the TExtractInlineParameters decoder
// (JSON_SQLDATE_MAGIC_C will be used as prefix to create '\uFFF1...' pattern)
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum<=?',[TimeLogToSql(TimeLogNow)]);
function TimeLogToSql(const Timestamp: TTimeLog): RawUtf8;
/// convert a Iso8601 encoded string into a ISO-8601 string format for SQL
// '?' inlined parameters
// - follows the same pattern as DateToSql or DateTimeToSql functions, i.e.
// will return the date or time encoded as '\uFFF1YYYY-MM-DDThh:mm:ss' -
// therefore ':("\uFFF12012-05-04T20:12:13"):' pattern will be recognized as a
// oftDateTime inline parameter by the TExtractInlineParameters decoder
// (JSON_SQLDATE_MAGIC_C will be used as prefix to create '\uFFF1...' pattern)
// - in practice, just append the JSON_BASE64_MAGIC_C prefix to the supplied text
function Iso8601ToSql(const S: RawByteString): RawUtf8;
{ ************ SQL Parameters Inlining and Processing }
type
/// generic parameter types, as recognized by TExtractInlineParameters.Parse
TSqlParamType = (
sptNull,
sptInteger,
sptFloat,
sptText,
sptBlob,
sptDateTime);
/// extract inlined :(1234): parameters into Types[]/Values[]
{$ifdef USERECORDWITHMETHODS}
TExtractInlineParameters = record
{$else}
TExtractInlineParameters = object
{$endif USERECORDWITHMETHODS}
public
/// Values[0..Count-1] contains the unquoted parameters raw values
Values: TRawUtf8DynArray;
/// generic SQL statement with ? place holders for each inlined parameter
GenericSql: RawUtf8;
/// the number of parsed parameters, as filled in Values/Types
Count: PtrInt;
/// the SQL type associated with each Values[]
// - recognized types are sptInteger, sptFloat, sptUtf8Text, sptDateTime
// (marked with '\uFFF1...' trailer) and sptBlob (with '\uFFF0...' trailer)
// - store sptNull for NULL value
Types: array[0..MAX_SQLFIELDS - 1] of TSqlParamType;
/// parse and extract inlined :(1234): parameters
// - fill Values[0..Count-1] Types[0..Count-1] Nulls and compute the
// associated GenericSQL with ? place-holders
// - if SQL as incorrect :(....): inlined parameters, will just copy SQL to
// GenericSQL and set Count=0
procedure Parse(const SQL: RawUtf8);
/// parse one UTF-8 SQL value, as encoded in our inlined :(....): format
// - low-level function called by Parse() into Values[Count] and Types[Count]
// - oftInteger is set for an INTEGER value, e.g. :(1234):
// - oftFloat is set for any floating point value (i.e. some digits
// separated by a '.' character), e.g. :(12.34): or :(12E-34):
// - oftUtf8Text is set for :("text"): or :('text'):, with double quoting
// inside the value
// - oftBlob will be recognized from the ':("\uFFF0base64encodedbinary"):'
// pattern, and set raw binary (for direct blob parameter assignment)
// - oftDateTime will be recognized from ':(\uFFF1"2012-05-04"):' pattern,
// i.e. JSON_SQLDATE_MAGIC_C-prefixed string as returned by DateToSql() or
// DateTimeToSql() functions, and set as ISO-8601 date/time text
// - oftUnknown is set from a NULL value
// - P=nil is returned on invalid content
function ParseNext(P: PUtf8Char): PUtf8Char;
/// release all used memory by this instance, so that it could be re-used
procedure Reset;
{$ifdef HASINLINE} inline; {$endif}
end;
/// returns a 64-bit value as inlined ':(1234):' text
function InlineParameter(ID: Int64): ShortString; overload;
/// returns a string value as inlined ':("value"):' text
function InlineParameter(const value: RawUtf8): RawUtf8; overload;
/// go to the beginning of the SQL statement, ignoring all blanks and comments
// - used to check the SQL statement command (e.g. is it a SELECT?)
function SqlBegin(P: PUtf8Char): PUtf8Char;
/// add a condition to a SQL WHERE clause, with an ' and ' if where is not void
procedure SqlAddWhereAnd(var where: RawUtf8; const condition: RawUtf8);
/// return true if the parameter is void or begin with a 'SELECT' SQL statement
// - used to avoid code injection and to check if the cache must be flushed
// - VACUUM, PRAGMA, or EXPLAIN statements also return true, since they won't
// change the data content
// - WITH recursive statement expect no INSERT/UPDATE/DELETE pattern in the SQL
// - if P^ is a SELECT and SelectClause is set to a variable, it would
// contain the field names, from SELECT ...field names... FROM
function IsSelect(P: PUtf8Char; SelectClause: PRawUtf8 = nil): boolean;
/// compute the SQL corresponding to a WHERE clause
// - returns directly the Where value if it starts with one the
// ORDER/GROUP/LIMIT/OFFSET/JOIN keywords
// - otherwise, append ' WHERE '+Where
function SqlFromWhere(const Where: RawUtf8): RawUtf8;
/// compute a SQL SELECT statement from its parameters
function SqlFromSelect(const TableName, Select, Where, SimpleFields: RawUtf8): RawUtf8;
/// find out if the supplied WHERE clause starts with one of the
// ORDER/GROUP/LIMIT/OFFSET/JOIN keywords
function SqlWhereIsEndClause(const Where: RawUtf8): boolean;
{$ifdef FPC} inline; {$endif}
/// get the order table name from a SQL statement
// - return the word following any 'ORDER BY' statement
// - return 'RowID' if none found
function SqlGetOrder(const Sql: RawUtf8): RawUtf8;
/// compute 'PropName in (...)' where clause for a SQL statement
// - if Values has no value, returns ''
// - if Values has a single value, returns 'PropName="Values0"' or inlined
// 'PropName=:("Values0"):' if ValuesInlined is true
// - if Values has more than one value, returns 'PropName in ("Values0","Values1",...)'
// or 'PropName in (:("Values0"):,:("Values1"):,...)' if length(Values)<ValuesInlinedMax
// - PropName can be used as a prefix to the 'in ()' clause, in conjunction
// with optional Suffix value
function SelectInClause(const PropName: RawUtf8; const Values: array of RawUtf8;
const Suffix: RawUtf8 = ''; ValuesInlinedMax: integer = 0): RawUtf8; overload;
/// compute 'PropName in (...)' where clause for a SQL statement
// - if Values has no value, returns ''
// - if Values has a single value, returns 'PropName=Values0' or inlined
// 'PropName=:(Values0):' if ValuesInlined is bigger than 1
// - if Values has more than one value, returns 'PropName in (Values0,Values1,...)'
// or 'PropName in (:(Values0):,:(Values1):,...)' if length(Values)<ValuesInlinedMax
// - PropName can be used as a prefix to the 'in ()' clause, in conjunction
// with optional Suffix value
function SelectInClause(const PropName: RawUtf8; const Values: array of TID;
const Suffix: RawUtf8 = ''; ValuesInlinedMax: integer = 0): RawUtf8; overload;
/// naive search of '... FROM TableName ...' pattern in the supplied SQL
function GetTableNameFromSqlSelect(const SQL: RawUtf8;
EnsureUniqueTableInFrom: boolean): RawUtf8;
/// naive search of '... FROM Table1,Table2 ...' pattern in the supplied SQL
function GetTableNamesFromSqlSelect(const SQL: RawUtf8): TRawUtf8DynArray;
{ ************ TResultsWriter Specialized for Database Export }
type
/// simple writer to a Stream, specialized for SQL export as JSON
// - i.e. define some property/method helpers to export SQL resultset as JSON
TResultsWriter = class(TJsonWriter)
protected
/// used to store output format
fExpand: boolean;
/// used to store output format for TOrm.GetJsonValues()
fWithID: boolean;
/// used to store field for TOrm.GetJsonValues()
fFields: TFieldIndexDynArray;
/// if not Expanded format, contains the Stream position of the first
// useful Row of data; i.e. ',val11' position in:
// & { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
fStartDataPosition: integer;
public
/// used internally to store column names and count for AddColumns
ColNames: TRawUtf8DynArray;
/// the data will be written to the specified Stream
// - if no Stream is supplied, a temporary memory stream will be created
// (it's faster to supply one, e.g. any TRest.TempMemoryStream)
constructor Create(aStream: TStream; Expand, withID: boolean;
const aFields: TFieldBits; aBufSize: integer = 8192); overload;
/// the data will be written to the specified Stream
// - if no Stream is supplied, a temporary memory stream will be created
// (it's faster to supply one, e.g. any TRest.TempMemoryStream)
constructor Create(aStream: TStream; Expand, withID: boolean;
const aFields: TFieldIndexDynArray = nil; aBufSize: integer = 8192;
aStackBuffer: PTextWriterStackBuffer = nil); overload;
/// rewind the Stream position and write void JSON object
procedure CancelAllVoid;
/// write or init field names for appropriate JSON Expand later use
// - ColNames[] must have been initialized before calling this procedure
// - if aKnownRowsCount is not null, a "rowCount":... item will be added
// to the generated JSON stream (for faster unserialization of huge content)
procedure AddColumns(aKnownRowsCount: integer = 0);
/// write or init field names for appropriate JSON Expand later use
// - accept a name directly supplied by the DB provider
// - if Expand is true, will set ColNames[] with the expected format
// - on Expand=false format, will directly write aColName to W
procedure AddColumn(aColName: PUtf8Char; aColIndex, aColCount: PtrInt);
/// allow to change on the fly an expanded format column layout
// - by definition, a non expanded format will raise a ESynDBException
// - caller should then set ColNames[] and run AddColumns()
procedure ChangeExpandedFields(aWithID: boolean;
const aFields: TFieldIndexDynArray); overload;
/// end the serialized JSON object
// - cancel last ','
// - close the JSON object ']' or ']}'
// - write non expanded postlog (,"rowcount":...), if needed
// - flush the internal buffer content if aFlushFinal=true
procedure EndJsonObject(aKnownRowsCount,aRowsCount: integer;
aFlushFinal: boolean = true);
{$ifdef HASINLINE}inline;{$endif}
/// the first data row is erased from the content
// - only works if the associated storage stream is TMemoryStream
// - expect not Expanded format
procedure TrimFirstRow;
/// is set to TRUE in case of Expanded format
property Expand: boolean
read fExpand write fExpand;
/// is set to TRUE if the ID field must be appended to the resulting JSON
// - this field is used only by TOrm.GetJsonValues
// - this field is ignored by TOrmTable.GetJsonValues
property WithID: boolean
read fWithID;
/// Read-Only access to the field indexes set for each column to be stored
property Fields: TFieldIndexDynArray
read fFields;
/// if not Expanded format, contains the Stream position of the first
// useful Row of data; i.e. ',val11' position in:
// & { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
property StartDataPosition: integer
read fStartDataPosition;
end;
{ ************ TSelectStatement SQL SELECT Parser }
type
/// function prototype used to retrieve the index of a specified property name
// - 'ID' is handled separately: here must be available only the custom fields
TOnGetFieldIndex = function(const PropName: RawUtf8): integer of object;
/// the recognized operators for a TSelectStatement where clause
TSelectStatementOperator = (
opEqualTo,
opNotEqualTo,
opLessThan,
opLessThanOrEqualTo,
opGreaterThan,
opGreaterThanOrEqualTo,
opIn,
opIsNull,
opIsNotNull,
opLike,
opContains,
opFunction);
/// a set of operators recognized by a TSelectStatement where clause
TSelectStatementOperators = set of TSelectStatementOperator;
/// one recognized SELECT expression for TSelectStatement
TSelectStatementSelect = record
/// the column SELECTed for the SQL statement, in the expected order
// - contains 0 for ID/RowID, or the RTTI field index + 1