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
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317 | ------------------------------------------------------------------------------
-- G N A T C O L L --
-- --
-- Copyright (C) 2005-2020, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
-- This package provides an object-oriented, high-level interface to SQL
-- queries.
-- Instead of using static strings to write queries, this package allows you
-- to write queries using Ada function calls. It helps to ensure the syntactic
-- validity of the resulting queries, and, some packages can automatically be
-- generated from your database (see below), ensures type-safety and that the
-- query only references existing fields of the database. An example of such a
-- query is:
--
-- Q : SQL_Query :=
-- SQL_Select
-- (Fields => Table1.Field1 & Table2.Field2,
-- From => Table1 & Table2,
-- Where => Table1.Field3 = Table2.Field4);
--
-- This checks, among other things, that Field3 and Field4 are of the same
-- type.
-- This package itself does not provide a way to execute a query on a given
-- database. See GNATCOLL.SQL.Exec for such facilities.
-- As a result, this package is independent of any DBMS, and in fact does not
-- even require one to be installed on your system.
--
-- Automatic generation of database description
-- =============================================
--
-- This package depends on having types and subprograms that describe the
-- structure of the database. Writing such packages manually is tedious and
-- error-prone. Instead, you should use the gnatcoll_db2ada tool to
-- automatically generate this description before each compilation. This
-- ensures that any SQL query in your application only references fields that
-- do exist in the database, and therefore helps detect at compilation time a
-- lot of possible errors that would otherwise only be detected at run time.
--
-- These generated packages should contain the following, for each table in
-- your database:
--
-- Ta_Table_Name : aliased constant String := "table_name";
-- package T_Table is
-- N_Field1 : aliased constant String := "field1";
-- N_Field2 : aliased constant String := "field2";
-- type Table (Instance : Cst_String_Access; Index : Integer)
-- is new SQL_Table (Ta_Table_Name'Access, Instance, Index) with
-- record
-- Field1 : SQL_Field_Integer
-- (Ta_Table_Name'Access, Instance, N_Field1'Access, Index);
-- Field2 : SQL_Field_Integer
-- (Ta_Table_Name'Access, Instance, N_Field2'Access, Index);
-- end record;
--
-- function FK (Self : Table; Foreign : SQL_Table'Class)
-- return SQL_Criteria;
--
-- end T_Table;
--
-- Finally, a default instance of the table that can be used in the queries:
-- Table : T_Table.Table (null, -1);
--
-- FK is a subprogram to retrieve the foreign keys between two tables, to
-- simplify the writing of the sql queries. This is optional, and if you are
-- maintaining this package by hand you might not want to generate these.
--
-- The reason to use a package like the above is to avoid naming conflicts
-- between the functions generated for the fields, and the name of the
-- instances (in the example above, if another table was called Field1, and we
-- weren't using a package, we would have a naming conflict).
--
-- This way, a user might write a query with two instances of the table with
-- the following code (which uses the Ada2005 dotted notation, although this
-- isn't mandatory):
-- AI : T_Sales_Entity.Table := T_Sales_Entity.Table
-- (Rename (Sales_Entity, "foo"));
-- SQL_Select
-- (Fields => AI.Field1 & Action_Item.Field1,
-- From => AI & Action_Item,
-- Where => AI.FK (Action_Item))
with Ada.Calendar;
with Ada.Containers.Vectors;
with Ada.Containers.Indefinite_Vectors;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with GNATCOLL.Refcount;
with GNATCOLL.SQL_Impl; use GNATCOLL.SQL_Impl;
package GNATCOLL.SQL is
-- Work around issue with the Ada containers: the tampering checks
-- mean that the container might be corrupted if used from multiple
-- tasks, even in read-only.
-- pragma Suppress (Tampering_Check);
subtype SQL_Criteria is GNATCOLL.SQL_Impl.SQL_Criteria;
type SQL_Criteria_Type is (Criteria_And,
Criteria_Or,
Criteria_In,
Criteria_Not_In,
Criteria_Exists,
Criteria_Between,
Criteria_Not_Between,
Criteria_Null,
Criteria_Not_Null,
Criteria_Not);
subtype Criteria_Combine
is SQL_Criteria_Type range Criteria_And .. Criteria_Or;
package Criteria_Lists is new Ada.Containers.Vectors
(Positive, SQL_Criteria);
subtype Criteria_List is Criteria_Lists.Vector;
type SQL_Query is tagged private;
-- A tagged type representing a query. This is a tagged type so that you
-- can use the dotted notation of Ada05 to call its primitive operations,
-- but you should not extend it
subtype Cst_String_Access is GNATCOLL.SQL_Impl.Cst_String_Access;
------------
-- Tables --
------------
subtype SQL_Table_Or_List is GNATCOLL.SQL_Impl.SQL_Table_Or_List;
-- Either a single table or a group of tables
subtype SQL_Single_Table is GNATCOLL.SQL_Impl.SQL_Single_Table;
-- Any type of table, or result of join between several tables. Such a
-- table can have fields
type SQL_Table_List is new SQL_Table_Or_List with private;
Empty_Table_List : constant SQL_Table_List;
-- A list of tables, as used in a SELECT query ("a, b")
package Table_List is new Ada.Containers.Indefinite_Vectors
(Natural, SQL_Single_Table'Class);
function Get_Tables (List : SQL_Table_List) return Table_List.Vector;
-- Returns list of the tables
type SQL_Table (Table_Name, Instance : GNATCOLL.SQL_Impl.Cst_String_Access;
Instance_Index : Integer)
is abstract new SQL_Single_Table with private;
function To_String (Self : SQL_Table'Class) return String;
overriding function To_String
(Self : SQL_Table; Format : Formatter'Class) return String;
-- A table representing a field of a specific table.
-- If Instance is specified (i.e. not null), the FROM clause will include:
-- SELECT ... FROM Table_Name Instance, ...
-- Otherwise, if Instance_Index is not -1, the FROM clause will include:
-- SELECT ... FROM Table_Name T<index>, ...
-- i.e. a generic name for the table.
-- Otherwise, the FROM clause will include:
-- SELECT ... FROM Table_Name, ...
--
-- The goal is to ensure unicity of the table in a query (for instance if a
-- table occurs several times in the FROM clause). So if you have a table
-- Names, which could occur several times in a query, you could either
-- provide explicit renaming of it, as in:
-- Aliased_Name : aliased constant String := "aliased_name";
-- Aliased_Table : T_Names (Instance => Aliased_Name'Access);
--
-- Q := SQL_Select (Fields => Aliased_Table.Name,
-- From => Aliased_Table, ...)
--
-- This will work fine in most cases. However, in some cases (automatically
-- generated queries for instance), you might not know in advance how many
-- of those renamings you will need, and therefore cannot create all the
-- "aliased constant String" in advance.
-- In such a case, using the Instance_Index might provide an easier way.
--
-- Aliased : T_Names (Instance => null, Instance_Index => 1); -- "t1"
-- Q := SQL_Select (Fields => Aliased.Name,
-- From => Aliased, ...)
type SQL_Unchecked_Table_Access is access constant SQL_Table'Class;
type SQL_Table_Access is access all SQL_Table'Class;
procedure Free (A : in out SQL_Table_Access);
-- Needs to be freed explicitly
function "&" (Left, Right : SQL_Table_List) return SQL_Table_List;
function "&" (Left, Right : SQL_Single_Table'Class) return SQL_Table_List;
function "&" (Left : SQL_Table_List; Right : SQL_Single_Table'Class)
return SQL_Table_List;
function "+" (Left : SQL_Single_Table'Class) return SQL_Table_List;
-- Create a list of tables, suitable for use in a SELECT query.
-- Note the operator "+" to create a list with a single element
-- For efficiency reasons, these operators try to reuse one of the lists
-- passed in parameter, append to it, and return it. That limits the number
-- of copies to be done, and thus the number of system calls to malloc.
------------
-- Fields --
------------
subtype SQL_Field_List is GNATCOLL.SQL_Impl.SQL_Field_List;
Empty_Field_List : constant SQL_Field_List :=
GNATCOLL.SQL_Impl.Empty_Field_List;
-- A list of fields, as used in a SELECT query ("field1, field2");
subtype SQL_Field is GNATCOLL.SQL_Impl.SQL_Field;
-- A single field
function As
(Field : SQL_Field'Class; Name : String) return SQL_Field'Class;
-- Rename a field in the output. This is equivalent to "field AS name".
-- The result is such that it can only be put in a list of fields, nothing
-- else.
function Desc (Field : SQL_Field'Class) return SQL_Field'Class;
function Asc (Field : SQL_Field'Class) return SQL_Field'Class;
-- Specify a specific sort order. This is only used in the Order_By clause
-- of a Select statement
package Integer_Parameters is new Scalar_Parameters
(Integer, "integer", Integer_To_SQL);
subtype SQL_Parameter_Integer is Integer_Parameters.SQL_Parameter;
package Integer_Fields is new Field_Types
(Integer, Integer_To_SQL, SQL_Parameter_Integer);
type SQL_Field_Integer is new Integer_Fields.Field with null record;
Null_Field_Integer : constant SQL_Field_Integer;
function Integer_Param (Index : Positive) return Integer_Fields.Field'Class
renames Integer_Fields.Param;
package Bigint_Parameters is new Scalar_Parameters
(Long_Long_Integer, "bigint", Bigint_To_SQL);
subtype SQL_Parameter_Bigint is Bigint_Parameters.SQL_Parameter;
package Bigint_Fields is new Field_Types
(Long_Long_Integer, Bigint_To_SQL, SQL_Parameter_Bigint);
type SQL_Field_Bigint is new Bigint_Fields.Field with null record;
Null_Field_Bigint : constant SQL_Field_Bigint;
function Bigint_Param (Index : Positive) return Bigint_Fields.Field'Class
renames Bigint_Fields.Param;
package Text_Fields is new Field_Types
(String, String_To_SQL, SQL_Parameter_Text);
type SQL_Field_Text is new Text_Fields.Field with null record;
Null_Field_Text : constant SQL_Field_Text;
function Text_Param (Index : Positive) return Text_Fields.Field'Class
renames Text_Fields.Param;
package Boolean_Parameters is new Scalar_Parameters
(Boolean, "boolean", Boolean_To_SQL);
subtype SQL_Parameter_Boolean is Boolean_Parameters.SQL_Parameter;
package Boolean_Fields is new Field_Types
(Boolean, Boolean_To_SQL, SQL_Parameter_Boolean);
type SQL_Field_Boolean is new Boolean_Fields.Field with null record;
Null_Field_Boolean : constant SQL_Field_Boolean;
function Boolean_Param (Index : Positive) return Boolean_Fields.Field'Class
renames Boolean_Fields.Param;
function Float_To_SQL is new Any_Float_To_SQL (Float);
package Float_Parameters is new Scalar_Parameters
(Float, "real", Float_To_SQL);
subtype SQL_Parameter_Float is Float_Parameters.SQL_Parameter;
package Float_Fields is new Field_Types
(Float, Float_To_SQL, SQL_Parameter_Float);
type SQL_Field_Float is new Float_Fields.Field with null record;
Null_Field_Float : constant SQL_Field_Float;
function Float_Param (Index : Positive) return Float_Fields.Field'Class
renames Float_Fields.Param;
function Long_Float_To_SQL is new Any_Float_To_SQL (Long_Float);
package Long_Float_Parameters is new Scalar_Parameters
(Long_Float, "float", Long_Float_To_SQL);
subtype SQL_Parameter_Long_Float is Long_Float_Parameters.SQL_Parameter;
package Long_Float_Fields is new Field_Types
(Long_Float, Long_Float_To_SQL, SQL_Parameter_Long_Float);
type SQL_Field_Long_Float is new Long_Float_Fields.Field with null record;
Null_Field_Long_Float : constant SQL_Field_Long_Float;
function Long_Float_Param
(Index : Positive) return Long_Float_Fields.Field'Class
renames Long_Float_Fields.Param;
subtype T_Money is GNATCOLL.SQL_Impl.T_Money;
function "=" (T1, T2 : T_Money) return Boolean renames SQL_Impl."=";
function "+" (T1, T2 : T_Money) return T_Money renames SQL_Impl."+";
function "-" (T1, T2 : T_Money) return T_Money renames SQL_Impl."-";
function "<" (T1, T2 : T_Money) return Boolean renames SQL_Impl."<";
function "<=" (T1, T2 : T_Money) return Boolean renames SQL_Impl."<=";
function ">" (T1, T2 : T_Money) return Boolean renames SQL_Impl.">";
function ">=" (T1, T2 : T_Money) return Boolean renames SQL_Impl.">=";
-- Make this type visible here, so that users do not have to explicitly
-- 'with' GNATCOLL.SQL_Impl.
package Money_Parameters is new Scalar_Parameters
(T_Money, "numeric", Money_To_SQL);
subtype SQL_Parameter_Money is Money_Parameters.SQL_Parameter;
package Money_Fields is new Field_Types
(T_Money, Money_To_SQL, SQL_Parameter_Money);
type SQL_Field_Money is new Money_Fields.Field with null record;
Null_Field_Money : constant SQL_Field_Money;
function Money_Param (Index : Positive) return Money_Fields.Field'Class
renames Money_Fields.Param;
package Time_Parameters is new Scalar_Parameters
(Ada.Calendar.Time, "timestamp", Time_To_SQL);
subtype SQL_Parameter_Time is Time_Parameters.SQL_Parameter;
package Time_Fields is new Field_Types
(Ada.Calendar.Time, Time_To_SQL, SQL_Parameter_Time);
type SQL_Field_Time is new Time_Fields.Field with null record;
Null_Field_Time : constant SQL_Field_Time;
function Time_Param (Index : Positive) return Time_Fields.Field'Class
renames Time_Fields.Param;
-- A timestamp, i.e. date + time
package Date_Parameters is new Scalar_Parameters
(Ada.Calendar.Time, "date", Date_To_SQL);
subtype SQL_Parameter_Date is Date_Parameters.SQL_Parameter;
package Date_Fields is new Field_Types
(Ada.Calendar.Time, Date_To_SQL, SQL_Parameter_Date);
type SQL_Field_Date is new Date_Fields.Field with null record;
Null_Field_Date : constant SQL_Field_Date;
function Date_Param (Index : Positive) return Date_Fields.Field'Class
renames Date_Fields.Param;
-- Only includes the date, not the time. Note: the date taken into account
-- is that of the Time value when interpreted in UT.
function From_String
(Expression : String) return Text_Fields.Field'Class
renames Text_Fields.From_String;
-- Create a field from sql core. Expression is an SQL statement, no check
-- is done though.
function Expression
(Value : String) return Text_Fields.Field'Class
renames Text_Fields.Expression;
function Expression
(Value : Integer) return Integer_Fields.Field'Class
renames Integer_Fields.Expression;
function Expression
(Value : Boolean) return Boolean_Fields.Field'Class
renames Boolean_Fields.Expression;
function Expression
(Value : Float) return Float_Fields.Field'Class
renames Float_Fields.Expression;
function Expression
(Value : Long_Float) return Long_Float_Fields.Field'Class
renames Long_Float_Fields.Expression;
function Expression
(Value : Ada.Calendar.Time) return Time_Fields.Field'Class
renames Time_Fields.Expression;
function Expression
(Value : Ada.Calendar.Time) return Date_Fields.Field'Class
renames Date_Fields.Expression;
-- Create constant fields (for a select statement for instance). The
-- expression is surrounded by quotes, and special characters are
-- escaped as needed
function As_Days
(Count : Natural) return Time_Fields.Field'Class;
function As_Days
(Count : Natural) return Date_Fields.Field'Class;
-- An expression representing a number of days
function Expression_Or_Null
(Value : String) return Text_Fields.Field'Class;
-- Same as above but if the Value is "NULL", returns NULL instead of 'NULL'
procedure Append (List : in out SQL_Field_List; Field : SQL_Field'Class)
renames GNATCOLL.SQL_Impl.Append;
function "+" (Left : SQL_Field'Class) return SQL_Field_List
renames GNATCOLL.SQL_Impl."+";
function "&" (Left, Right : SQL_Field_List) return SQL_Field_List
renames GNATCOLL.SQL_Impl."&";
function "&" (Left, Right : SQL_Field'Class) return SQL_Field_List
renames GNATCOLL.SQL_Impl."&";
function "&"
(Left : SQL_Field_List; Right : SQL_Field'Class) return SQL_Field_List
renames GNATCOLL.SQL_Impl."&";
function "&"
(Left : SQL_Field'Class; Right : SQL_Field_List) return SQL_Field_List
renames GNATCOLL.SQL_Impl."&";
function "&" (List : SQL_Field_List; Value : String) return SQL_Field_List
renames Text_Fields."&";
function "&" (List : SQL_Field'Class; Value : String) return SQL_Field_List
renames Text_Fields."&";
function "&" (Value : String; List : SQL_Field_List) return SQL_Field_List
renames Text_Fields."&";
function "&" (Value : String; List : SQL_Field'Class) return SQL_Field_List
renames Text_Fields."&";
function "&" (List : SQL_Field_List; Value : Integer) return SQL_Field_List
renames Integer_Fields."&";
function "&" (Value : Integer; List : SQL_Field_List) return SQL_Field_List
renames Integer_Fields."&";
function "&" (List : SQL_Field'Class; Value : Integer) return SQL_Field_List
renames Integer_Fields."&";
function "&" (Value : Integer; List : SQL_Field'Class) return SQL_Field_List
renames Integer_Fields."&";
function "&" (List : SQL_Field_List; Value : Boolean) return SQL_Field_List
renames Boolean_Fields."&";
function "&" (Value : Boolean; List : SQL_Field_List) return SQL_Field_List
renames Boolean_Fields."&";
function "&" (List : SQL_Field'Class; Value : Boolean) return SQL_Field_List
renames Boolean_Fields."&";
function "&" (Value : Boolean; List : SQL_Field'Class) return SQL_Field_List
renames Boolean_Fields."&";
-- Create a list of fields, suitable for use in a SELECT query
function "-" is new Time_Fields.Operator ("-");
function "+" is new Time_Fields.Operator ("+");
function "-" is new Date_Fields.Operator ("-");
function "+" is new Date_Fields.Operator ("+");
function "-" is new Integer_Fields.Scalar_Operator (Integer, "-");
function "+" is new Integer_Fields.Scalar_Operator (Integer, "+");
function "*" is new Integer_Fields.Scalar_Operator (Integer, "*");
function "/" is new Integer_Fields.Scalar_Operator (Integer, "/");
function Collate is new Text_Fields.String_Operator ("COLLATE", """", """");
-- Assigns a collating sequence to an expression
function Current_Date is new Date_Fields.SQL_Function ("current_date");
-- Returns current date
function Current_Timestamp
is new Time_Fields.SQL_Function ("current_timestamp");
-- Returns start of transaction timestamp with timezone
function Current_Time
is new Time_Fields.SQL_Function ("current_time");
-- Returns current time (without date) with timezone
function Local_Timestamp
is new Time_Fields.SQL_Function ("localtimestamp");
-- Returns start of transaction timestamp without timezone
function Local_Time
is new Time_Fields.SQL_Function ("localtime");
-- Returns current time (without date) in local timezone without timezone
function Clock_Timestamp
is new Time_Fields.SQL_Function ("clock_timestamp()");
-- Returns current timestamp with timezone
function Absolute
(Field : SQL_Field'Class) return Integer_Fields.Field'Class with Inline;
function Lower
(Field : SQL_Field'Class) return Text_Fields.Field'Class with Inline;
function Upper
(Field : SQL_Field'Class) return Text_Fields.Field'Class with Inline;
function Initcap
(Field : SQL_Field'Class) return Text_Fields.Field'Class with Inline;
function Trim
(Field : SQL_Field'Class) return Text_Fields.Field'Class with Inline;
-- Return the corresponding SQL function applied on Field
function Cast_To_String
(Field : SQL_Field'Class) return Text_Fields.Field'Class;
-- Convert any field type to a text field
function Cast_To_Date
(Field : SQL_Field'Class) return Date_Fields.Field'Class;
-- Convert a field to a date
function Cast_To_Integer
(Field : SQL_Field'Class) return Integer_Fields.Field'Class;
-- Convert a field to an integer
function At_Time_Zone
(Field : Time_Fields.Field'Class; TZ : String)
return Time_Fields.Field'Class;
-- Convert a 'timestamp with time zone' expression to another time zone
function To_Char
(Field : Time_Fields.Field'Class; Format : String)
return Text_Fields.Field'Class;
-- Format a date field, as in "to_char (field, "format")"
function Extract
(Field : Time_Fields.Field'Class; Attribute : String)
return Time_Fields.Field'Class;
function Extract
(Field : Date_Fields.Field'Class; Attribute : String)
return Date_Fields.Field'Class;
-- Return the result of "extract (attribute from field)"
function As_Boolean
(Criteria : SQL_Criteria) return SQL_Field'Class;
-- A SQL criteria used as a field
-------------------------
-- Aggregate functions --
-------------------------
type Aggregate_Function is new String;
Func_Count : constant Aggregate_Function := "count";
Func_Distinct : constant Aggregate_Function := "distinct";
Func_Min : constant Aggregate_Function := "min";
Func_Max : constant Aggregate_Function := "max";
Func_Sum : constant Aggregate_Function := "sum";
Func_Bool_And : constant Aggregate_Function := "bool_and";
Func_Bool_Or : constant Aggregate_Function := "bool_or";
-- Func_Distinct is not useful in general, since the various calls to
-- SQL_Select below have their own Distinct parameter. However, it is
-- useful in constructs such as "count (distinct a.b)", which can be
-- constructed as Apply (Func_Count, Apply (Func_Distinct, "a.b"))
--
-- If you need to compare the count, for instance, you should use a
-- syntax similar to:
-- Greater_Or_Equal (Apply (Func_Count, field_name), 2)
function Apply
(Func : Aggregate_Function;
Fields : SQL_Field_List;
Order_By : SQL_Field_Or_List'Class := Empty_Field_List)
return SQL_Field'Class;
function Apply
(Func : Aggregate_Function;
Criteria : SQL_Criteria;
Order_By : SQL_Field_Or_List'Class := Empty_Field_List)
return SQL_Field'Class;
function Apply
(Func : Aggregate_Function;
Field : SQL_Field'Class;
Order_By : SQL_Field_Or_List'Class := Empty_Field_List)
return SQL_Field'Class;
-- Apply an aggregate function to a field. Other fields in the result of
-- the query should be grouped. Each element of Fields is taken as one of
-- the arguments to Func.
-- The result of this function is an untyped field. If you need to compare
-- this result with some other field or value, you should use the
-- functions Greater_Than, Less_Than, ... below, rather than the usual
-- operators.
---------------------------------
-- Functions on list of fields --
---------------------------------
-- The following functions apply to lists of fields, and return a single
-- field. A generic version is provided so that you can implement your own.
generic
Func_Name : String := "";
Separator : String := ",";
Suffix : String := "";
function Field_List_Function
(Fields : SQL_Field_List) return SQL_Field'Class;
-- A function that applies to multiple fields, as in
-- Func_Name [Separator Field1]* Suffix
-- For instance, "coalesce (a, b, c)"
-- The parenthesis must be part of Func_Name and Suffix if they are needed.
function Concat (Fields : SQL_Field_List) return SQL_Field'Class;
-- Converts the list into a concatenation of fields, as in:
-- "prefix " || foo.bar || "suffix"
function Tuple (Fields : SQL_Field_List) return SQL_Field'Class;
-- Return the list of fields as a tuple, i.e. (field1, field2)
function Coalesce (Fields : SQL_Field_List) return SQL_Field'Class;
-- Returns the first of its arguments that is not null
-- Coalesce (value1, value2, ...)
---------------------
-- Case statements --
---------------------
-- SQL can have case statements in the field part of a select statement.
-- For instance, SELECT CASE WHEN a = b THEN a ELSE '' END FROM ...
type When_List is private;
function SQL_Case
(List : When_List; Else_Clause : SQL_Field'Class := Null_Field_Text)
return SQL_Field'Class;
-- Return a case statement made of one or several WHEN clause.
-- If none of the WHEN clause matches, Else_Clause will be executed
-- instead
function SQL_When
(Criteria : SQL_Criteria; Field : SQL_Field'Class) return When_List;
-- Display Field if Criteria is true
function "&" (List1, List2 : When_List) return When_List;
-- Concatenate two WHEN statements
---------------------
-- Array of fields --
---------------------
-- This array plays a similar role to a field_list. The idea is that you
-- can explicitly specify the index of each file, and thus ensure more
-- consistency in your application. For instance, you would do the
-- following:
-- Field_First_Name : constant := 0;
-- Field_Last_Name : constant := 1;
-- SQL_Select (Fields => To_List
-- ((Field_First_Name => +Create ("first"),
-- Field_Last_Name => +Create ("last"))),
-- From => ...);
-- and you can then retrieve the specific fields in each row of the result
-- by using the constant indexes, which ensures more consistency.
-- The first element in the array should always be 0 for that purpose.
subtype SQL_Field_Pointer is GNATCOLL.SQL_Impl.SQL_Field_Pointer;
function "+" (Field : SQL_Field'Class) return SQL_Field_Pointer
renames GNATCOLL.SQL_Impl."+";
-- Create a new pointer. Memory will be deallocated automatically
type SQL_Field_Array is array (Natural range <>) of SQL_Field_Pointer;
function To_List (Fields : SQL_Field_Array) return SQL_Field_List;
-- Convert the array into a list
--------------
-- Criteria --
--------------
-- Most of the comparison operators ("<=", "<", "=", ">=", ">") are
-- automatically inherited from gnatcoll.sql_impl types by the
-- SQL_Field_Text, SQL_Field_Integer,... types. They thus do not appear in
-- this API, although they are usable directly within your code.
-- There is however one case where these attributes are not inherited: the
-- result of the functions like As_Days, Lower,... are of a type
-- Text_Fields.Field, not SQL_Field_Text. As a result, their operators are
-- not directly visible in your package. You should add
-- use type Text_Fields.Field;
-- in your package to make the operators visible.
No_Criteria : constant SQL_Criteria := GNATCOLL.SQL_Impl.No_Criteria;
function "=" (C1, C2 : SQL_Criteria) return Boolean
renames GNATCOLL.SQL_Impl."=";
function Length (Self : SQL_Criteria) return Natural;
-- Returns number of criteria on the upper level delimited by the same
-- logical operator "OR" or "AND".
function Is_Or (Self : SQL_Criteria) return Boolean;
-- Returns true if the Self is criteria delimited by the OR operator on the
-- upper level.
function Is_And (Self : SQL_Criteria) return Boolean;
-- Returns true if the Self is criteria delimited by the AND operator on
-- the upper level.
function Combine
(List : Criteria_List; Op : Criteria_Combine) return SQL_Criteria;
-- Returns SQL_Criteria combined from List with a specific operator
function Greater_Than
(Left : SQL_Field'Class; Right : Integer) return SQL_Criteria
renames Integer_Fields.Greater_Than;
function Greater_Or_Equal
(Left : SQL_Field'Class; Right : Integer) return SQL_Criteria
renames Integer_Fields.Greater_Or_Equal;
function Equal
(Left : SQL_Field'Class; Right : Boolean) return SQL_Criteria
renames Boolean_Fields.Equal;
-- Same as ">" and ">=", but usable for instance for aggregate fields
-- resulting from the use of Apply.
function "and" (Left, Right : SQL_Criteria) return SQL_Criteria;
function "or" (Left, Right : SQL_Criteria) return SQL_Criteria;
-- Combine two criterias
function "and"
(Left : SQL_Criteria; Right : Boolean_Fields.Field'Class)
return SQL_Criteria;
function "or"
(Left : SQL_Criteria; Right : Boolean_Fields.Field'Class)
return SQL_Criteria;
-- Combine two criterias, one of which is for a boolean test. This is just
-- to simplify the writing.
function "not" (Left : Boolean_Fields.Field'Class) return SQL_Criteria;
-- Test that Left is False. This can also be done with an explicit call to
-- "=" above.
function "not" (Self : SQL_Criteria) return SQL_Criteria;
-- Return the opposite of Self
function SQL_In
(Self : SQL_Field'Class; List : SQL_Field_List) return SQL_Criteria;
function SQL_In
(Self : SQL_Field'Class; List : String) return SQL_Criteria;
function SQL_In
(Self : SQL_Field'Class; Subquery : SQL_Query) return SQL_Criteria;
function SQL_Not_In
(Self : SQL_Field'Class; List : SQL_Field_List) return SQL_Criteria;
function SQL_Not_In
(Self : SQL_Field'Class; List : String) return SQL_Criteria;
function SQL_Not_In
(Self : SQL_Field'Class; Subquery : SQL_Query) return SQL_Criteria;
-- Whether Self is equal to any of the values in List.
-- If List is an empty list, this returns an always-false criteria.
--
-- This diverges from pure sql, since "F IN ()" is invalid in SQL, though
-- in Ada "for A of Empty_List" is valid and simply does nothing. It is
-- easy to forget to test whether you are passing an empty list, and it
-- seems more user friendly to simply do nothing in this case.
function SQL_Between
(Self, Left, Right : SQL_Field'Class) return SQL_Criteria;
function SQL_Not_Between
(Self, Left, Right : SQL_Field'Class) return SQL_Criteria;
function Any
(Self, Str : Text_Fields.Field'Class) return SQL_Criteria;
-- "Self = ANY (Str)"
function Ilike
(Self : Text_Fields.Field'Class; Str : String) return SQL_Criteria;
function Ilike
(Self : Text_Fields.Field'Class; Field : SQL_Field'Class)
return SQL_Criteria;
function Like
(Self : Text_Fields.Field'Class; Str : String) return SQL_Criteria;
function Like
(Self : Text_Fields.Field'Class; Field : Text_Fields.Field'Class)
return SQL_Criteria;
function Not_Ilike
(Self : Text_Fields.Field'Class; Str : String) return SQL_Criteria;
function Not_Like
(Self : Text_Fields.Field'Class; Str : String) return SQL_Criteria;
-- Return a resp. case-insensitive or case-sensitive pattern matching.
-- Right is automatically quoted. However, you are responsible for
-- putting the meta-character % at the right places in Right.
function Is_Null (Self : SQL_Field'Class) return SQL_Criteria;
function Is_Not_Null (Self : SQL_Field'Class) return SQL_Criteria;
-- Test whether a field is null or not (i.e. unset or set)
function Overlaps (Left, Right : SQL_Field'Class) return SQL_Criteria
with Obsolescent => "See GNATCOLL.SQL.Ranges.Overlap instead";
-- Whether the range specified in Left overlaps the range specified in
-- Right.
-- It is recommended to use GNATCOLL.SQL.Ranges instead (for postgreSQL)
-- which provides full support for ranges.
function Exists (Subquery : SQL_Query) return SQL_Criteria;
-- "EXISTS (subquery)"
-- Returns True if the subquery returns at least one row.
-----------------
-- Assignments --
-----------------
-- The operator "=" is inherited from gnatcoll-sql_impl for all fields
-- (either between two fields, or between a field and a scalar value).
subtype SQL_Assignment is GNATCOLL.SQL_Impl.SQL_Assignment;
No_Assignment : constant SQL_Assignment;
function "=" (Left, Right : SQL_Assignment) return Boolean
renames GNATCOLL.SQL_Impl."=";
-- Compare two assignments (this makes the implicit equality visible to
-- users of this package who haven't "use"d GNATCOLL.SQL_Impl
function "&" (Left, Right : SQL_Assignment) return SQL_Assignment
renames GNATCOLL.SQL_Impl."&";
-- Create a list of assignments
function "="
(Left : SQL_Field'Class; Query : SQL_Query) return SQL_Assignment;
-- Set the value of one or more fields base on the result of a query.
-- There is no type checking here, so this should be used with care.
-------------
-- Queries --
-------------
type SQL_Left_Join_Table is new SQL_Single_Table with private;
-- A special kind of table that represents a join between two tables
function Rename
(Self : SQL_Left_Join_Table; Name : Cst_String_Access)
return SQL_Left_Join_Table'Class;
-- Returns a new instance of Self, with a different name.
-- No deallocation is ever done for Name, see Cst_String_Access
function Left_Join
(Full : SQL_Single_Table'Class;
Partial : SQL_Single_Table'Class;
On : SQL_Criteria) return SQL_Left_Join_Table;
-- Performs a left join between the two tables. It behaves like a standard
-- join, but if a row from Full doesn't match any row in Partial, a virtual
-- row full of NULL is added to Partial, and returned in the join.
function Join
(Table1 : SQL_Single_Table'Class;
Table2 : SQL_Single_Table'Class;
On : SQL_Criteria := No_Criteria) return SQL_Left_Join_Table;
-- Join the two tables
function SQL_Select
(Fields : SQL_Field_Or_List'Class;
From : SQL_Table_Or_List'Class := Empty_Table_List;
Where : SQL_Criteria := No_Criteria;
Group_By : SQL_Field_Or_List'Class := Empty_Field_List;
Having : SQL_Criteria := No_Criteria;
Order_By : SQL_Field_Or_List'Class := Empty_Field_List;
Limit : Integer := -1;
Offset : Integer := -1;
Distinct : Boolean := False;
Auto_Complete : Boolean := False) return SQL_Query;
-- Select one or more fields from one or more tables
-- If Auto_Complete is true, the resulting query is auto-completed just as
-- if you had called the Auto_Complete subprogram. This is put here so that
-- you can have global SQL_Query constants, pre-completed
function SQL_Union
(Query1, Query2 : SQL_Query;
Order_By : SQL_Field_Or_List'Class := Empty_Field_List;
Limit : Integer := -1;
Offset : Integer := -1;
Distinct : Boolean := False) return SQL_Query;
-- Join the two queries with a Union.
-- The Limit, Offset and Order_By parameters for each query will be
-- ignored by the DBMS. When the union is itself used in another union,
-- only the outer-most union will have its Order_By, Limit and Offset
-- taken into account.
function SQL_Insert
(Values : SQL_Assignment;
Where : SQL_Criteria := No_Criteria;
Limit : Integer := -1;
Qualifier : String := "") return SQL_Query;
-- Insert a new row in the table specified by the left-hand side of
-- the assignments. All these left-hand side fields must belong to the same
-- table, or the query is ambiguous and will raise a Program_Error.
-- The right-hand side of the assignments, though, can either be constants
-- or fields from other tables. When other tables are referenced, the
-- insert statement is transformed into an INSERT with a subquery (see
-- below), and WHERE is used as the WHERE claused for that subquery.
--
-- Qualifier is inserted just after the "INSERT" keyword, in the query. It
-- can be used for DBMS-specific queries, like "INSERT OR IGNORE" in
-- sqlite, "INSERT IGNORE" in mysql,...
function SQL_Insert
(Fields : SQL_Field_Or_List'Class;
Values : SQL_Query;
Qualifier : String := "") return SQL_Query;
-- Insert a new row in the table. The list of values come from a subquery
function SQL_Insert_Default_Values
(Table : SQL_Table'Class) return SQL_Query;
-- Insert a new row in the table using default values for all fields
function SQL_Update
(Table : SQL_Table'Class;
Set : SQL_Assignment;
Where : SQL_Criteria := No_Criteria;
From : SQL_Table_Or_List'Class := Empty_Table_List) return SQL_Query;
-- Update the contents of a table.
-- Where specifies which rows of the table are affected by the change.
-- From should be used if Where references other tables. It can be
-- auto-completed
function SQL_Delete
(From : SQL_Table'Class;
Where : SQL_Criteria := No_Criteria) return SQL_Query;
-- Deletes all rows matching WHERE in the table FROM
type Temp_Table_Behavior is (Preserve_Rows, Delete_Rows, Drop);
function SQL_Create_Table
(Name : String;
As : SQL_Query;
Temp : Boolean := False;
On_Commit : Temp_Table_Behavior := Preserve_Rows) return SQL_Query;
-- CREATE [TEMP] TABLE AS
-- "as" could be the result of a SQL_Select, or SQL_Values for instance.
type Field_List_Array is array (Natural range <>) of SQL_Field_List;
function SQL_Values (Val : Field_List_Array) return SQL_Query;
-- A query that returns one row for each element in the array Val.
-- Each element in the array is itself a tuple, which results in several
-- columns in the output.
-- This command is mostly useful with SQL_Create_Table.
-- For instance:
-- Q := SQL_Create_Table
-- (Name => "tmp", Temp => True, On_Commit => Drop,
-- As => Values
-- ((1 => Expression (1) & Expression ("name1"),
-- 2 => Expression (2) & Expression ("name2"))));
--
-- This is a quick way to create a temporary table on the server, that can
-- then be reused in other queries.
function SQL_Begin return SQL_Query;
function SQL_Rollback return SQL_Query;
function SQL_Commit return SQL_Query;
-- Support for transactions
function SQL_Lock (Table : SQL_Table'Class) return SQL_Query;
-- Lock a table. This is a postgres extension
procedure Auto_Complete
(Self : in out SQL_Query;
Auto_Complete_From : Boolean := True;
Auto_Complete_Group_By : Boolean := True);
-- Automatically complete missing fields in the query, based on other
-- fields.
-- For a Select query, this includes the list of tables in From if
-- Auto_Complete_From is true, and the list of fields in GROUP BY if
-- Auto_Complete_Group_By is true.
-----------------------
-- Extending queries --
-----------------------
-- It is often convenient to have slightly similar versions of queries, but
-- with a few differences. For instance, you might want to prepare a
-- first version of the query, and then have a second version with
-- additional criteria.
-- Q : SQL_Query := SQL_Select (...);
-- P : Prepared_Statement := Prepare (Q);
-- Q2 : SQL_Query := Q.Where_And (...);
function Where_And
(Query : SQL_Query; Where : SQL_Criteria) return SQL_Query;
function Where_Or
(Query : SQL_Query; Where : SQL_Criteria) return SQL_Query;
-- Add a new "and" or "or" clause to the query (which must be a SELECT
-- query). The result is a separate query which can be modified
-- independently of Query.
-- This does not auto-complete the result query, even if the original
-- query had been auto-completed.
function Order_By
(Query : SQL_Query; Order_By : SQL_Field_Or_List'Class)
return SQL_Query;
-- Adds extra field in the order_by part of the query. These are added
-- *before* the order_by clause of Query, so that they take priority
function Distinct (Query : SQL_Query) return SQL_Query;
-- Remove duplicate rows in the result of query
function Offset (Query : SQL_Query; Offset : Natural) return SQL_Query;
function Limit (Query : SQL_Query; Limit : Natural) return SQL_Query;
-- Modifies the "limit" and "offset" in the query. This is useful if you
-- need to repeat the query several times to get various pages of results
-----------------------
-- subqueries tables --
-----------------------
-- These tables represent subqueries as used in a "FROM" list.
-- There is no support for using subqueries in the list of fields: it is
-- just more efficient to perform two separate queries in such a case.
-- Example of use:
-- N_Sorted : aliased constant String := "sorted";
-- Sorted : constant Subquery_Table :=
-- Subquery (SQL_Select (Config.Name, ...), N_Sorted'Access);
-- Sorted_Config : constant Text_Fields.Field'Class :=
-- Config.Name.From_Table (Sorted);
--
-- You can then use the table Sorted in any SQL_Select query, and access
-- its fields via Sorted_Config.
type Subquery_Table is new SQL_Single_Table with private;
function Subquery
(Query : SQL_Query'Class; Table_Name : Cst_String_Access)
return Subquery_Table;
-- Create a temporary subquery table, as in:
-- select * from b, (select ...) a where ...
-- A := Subquery ("select ...", "a");
-- Table_Name is never freed, and should therefore point to a "aliased
-- constant String" in your code
-- See the various inherited Field subprograms to reference specific fields
-- from the result of the query.
overriding function To_String
(Self : Subquery_Table; Format : Formatter'Class) return String;
---------------------------
-- Conversion to strings --
---------------------------
function To_String
(Self : SQL_Query; Format : Formatter'Class) return Unbounded_String;
-- Transform Self into a valid SQL string
private
-------------------------
-- Table and instances --
-------------------------
type SQL_Table (Table_Name, Instance : Cst_String_Access;
Instance_Index : Integer)
is abstract new
SQL_Single_Table (Instance, Instance_Index) with null record;
overriding procedure Append_Tables
(Self : SQL_Table; To : in out Table_Sets.Set);
------------------
-- Tables lists --
------------------
package Table_List_Pointers is
new Refcount.Shared_Pointers (Table_List.Vector);
-- Store the actual data for a SQL_Table_List in a different block (using
-- a smart pointer for reference counting), since otherwise all the calls
-- to "&" result in a copy of the list (per design of the Ada05 containers)
-- which shows up as up to 20% of the number of calls to malloc on the
-- testsuite).
subtype Table_List_Data is Table_List_Pointers.Ref;
type SQL_Table_List is new SQL_Table_Or_List with record
Data : Table_List_Data;
end record;
overriding function To_String
(Self : SQL_Table_List; Format : Formatter'Class) return String;
overriding procedure Append_Tables
(Self : SQL_Table_List; To : in out Table_Sets.Set);
-- Append all the tables referenced in Self to To
Empty_Table_List : constant SQL_Table_List :=
(SQL_Table_Or_List with Data => Table_List_Pointers.Null_Ref);
function Get_Tables (List : SQL_Table_List) return Table_List.Vector is
(if List.Data.Is_Null then Table_List.Empty_Vector else List.Data.Get);
-----------
-- Field --
-----------
-- This type hierarchy for fields includes several types. It could be made
-- smaller, but the goals are to keep the declaration of simple fields
-- ("table.field") as simple as possible, and avoid using controlled types
-- for those for maximum efficiency.
procedure Append_If_Not_Aggregate
(Self : SQL_Field_List;
To : in out SQL_Field_List'Class;
Is_Aggregate : in out Boolean);
-- Append all fields referenced in Self to To, if Self is not the result of
-- an aggregate function
--------------
-- Criteria --
--------------
subtype Null_Criteria
is SQL_Criteria_Type range Criteria_Null .. Criteria_Not_Null;
type SQL_Criteria_Data (Op : SQL_Criteria_Type) is
new GNATCOLL.SQL_Impl.SQL_Criteria_Data with record
case Op is
when Criteria_Combine =>
Criterias : Criteria_List;
when Criteria_In | Criteria_Not_In =>
Arg : SQL_Field_Pointer;
List : SQL_Field_List;
Subquery : SQL_Query;
In_String : Ada.Strings.Unbounded.Unbounded_String;
when Criteria_Exists =>
Subquery2 : SQL_Query;
when Criteria_Between | Criteria_Not_Between =>
Arg2 : SQL_Field_Pointer;
Left : SQL_Field_Pointer;
Right : SQL_Field_Pointer;
when Null_Criteria =>
Arg3 : SQL_Field_Pointer;
when Criteria_Not =>
Criteria : SQL_Criteria;
end case;
end record;
overriding function To_String
(Self : SQL_Criteria_Data;
Format : Formatter'Class;
Long : Boolean := True) return String;
overriding procedure Append_Tables
(Self : SQL_Criteria_Data; To : in out Table_Sets.Set);
overriding procedure Append_If_Not_Aggregate
(Self : SQL_Criteria_Data;
To : in out SQL_Field_List'Class;
Is_Aggregate : in out Boolean);
----------------------
-- Case statements --
----------------------
type When_List_Item is record
Criteria : SQL_Criteria;
Field : SQL_Field_Pointer;
end record;
package When_Lists is new Ada.Containers.Indefinite_Vectors
(Natural, When_List_Item);
type When_List is record
List : When_Lists.Vector;
end record;
type Case_Stmt_Internal is new SQL_Field_Internal with record
Criteria : When_List;
Else_Clause : SQL_Field_Pointer;
end record;
type Case_Stmt_Internal_Access is access all Case_Stmt_Internal'Class;
overriding function To_String
(Self : Case_Stmt_Internal;
Format : Formatter'Class;
Long : Boolean) return String;
overriding procedure Append_Tables
(Self : Case_Stmt_Internal; To : in out Table_Sets.Set);
overriding procedure Append_If_Not_Aggregate
(Self : access Case_Stmt_Internal;
To : in out SQL_Field_List'Class;
Is_Aggregate : in out Boolean);
-- For all functions with multiple arguments (Concat, Coalesce,...)
---------------
-- Left join --
---------------
type Join_Table_Internal is record
Tables : SQL_Table_List;
On : SQL_Criteria;
Is_Left_Join : Boolean;
end record;
package Join_Table_Pointers is
new Refcount.Shared_Pointers (Join_Table_Internal);
subtype Join_Table_Data is Join_Table_Pointers.Ref;
-- The contents of a join table is in a smart pointer. That way, we avoid
-- duplicating the data (especially the Ada2005 containers) whenever we
-- "Adjust" a SQL_Left_Join_Table, which saves a number of system calls to
-- malloc() and free()
type SQL_Left_Join_Table is new SQL_Single_Table with record
Data : Join_Table_Data;
end record;
overriding function To_String
(Self : SQL_Left_Join_Table; Format : Formatter'Class) return String;
overriding procedure Append_Tables
(Self : SQL_Left_Join_Table; To : in out Table_Sets.Set);
-----------------
-- Assignments --
-----------------
No_Assignment : constant SQL_Assignment :=
GNATCOLL.SQL_Impl.No_Assignment;
-------------
-- Queries --
-------------
type Query_Contents is abstract new GNATCOLL.Refcount.Refcounted
with null record;
function To_String
(Self : Query_Contents;
Format : Formatter'Class) return Unbounded_String is abstract;
procedure Auto_Complete
(Self : in out Query_Contents;
Auto_Complete_From : Boolean := True;
Auto_Complete_Group_By : Boolean := True) is null;
package Query_Pointers is new GNATCOLL.Refcount.Smart_Pointers
(Query_Contents);
type SQL_Query is new Query_Pointers.Ref with null record;
No_Query : constant SQL_Query := (Query_Pointers.Null_Ref with null record);
type Query_Select_Contents is new Query_Contents with record
Fields : SQL_Field_List;
Tables : SQL_Table_List;
Extra_Tables : Table_Sets.Set; -- auto completed tables
Criteria : SQL_Criteria;
Group_By : SQL_Field_List;
Having : SQL_Criteria;
Order_By : SQL_Field_List;
Limit : Integer;
Offset : Integer;
Distinct : Boolean;
end record;
overriding function To_String
(Self : Query_Select_Contents;
Format : Formatter'Class) return Unbounded_String;
overriding procedure Auto_Complete
(Self : in out Query_Select_Contents;
Auto_Complete_From : Boolean := True;
Auto_Complete_Group_By : Boolean := True);
type Query_Union_Contents is new Query_Contents with record
Q1, Q2 : SQL_Query;
Order_By : SQL_Field_List;
Limit : Integer;
Offset : Integer;
Distinct : Boolean;
end record;
overriding function To_String
(Self : Query_Union_Contents;
Format : Formatter'Class) return Unbounded_String;
type Query_Insert_Contents is new Query_Contents with record
Into : Table_Names := No_Names;
Default_Values : Boolean := False;
Qualifier : Unbounded_String;
Fields : SQL_Field_List;
Values : SQL_Assignment;
Where : SQL_Criteria;
Limit : Integer := -1;
Subquery : SQL_Query := No_Query;
end record;
overriding function To_String
(Self : Query_Insert_Contents;
Format : Formatter'Class) return Unbounded_String;
overriding procedure Auto_Complete
(Self : in out Query_Insert_Contents;
Auto_Complete_From : Boolean := True;
Auto_Complete_Group_By : Boolean := True);
type Query_Update_Contents is new Query_Contents with record
Table : SQL_Table_List;
Set : SQL_Assignment;
Where : SQL_Criteria;
From : SQL_Table_List;
Extra_From : Table_Sets.Set; -- from auto complete
end record;
overriding function To_String
(Self : Query_Update_Contents;
Format : Formatter'Class) return Unbounded_String;
overriding procedure Auto_Complete
(Self : in out Query_Update_Contents;
Auto_Complete_From : Boolean := True;
Auto_Complete_Group_By : Boolean := True);
type Query_Delete_Contents is new Query_Contents with record
Table : SQL_Table_List;
Where : SQL_Criteria;
end record;
overriding function To_String
(Self : Query_Delete_Contents;
Format : Formatter'Class) return Unbounded_String;
type Query_Create_Table_As_Contents is new Query_Contents with record
Name : Ada.Strings.Unbounded.Unbounded_String;
Temp : Boolean;
On_Commit : Temp_Table_Behavior;
As : SQL_Query;
end record;
overriding function To_String
(Self : Query_Create_Table_As_Contents;
Format : Formatter'Class) return Unbounded_String;
type Query_Values_Contents
(Size : Natural) is new Query_Contents
with record
Values : Field_List_Array (1 .. Size);
end record;
overriding function To_String
(Self : Query_Values_Contents;
Format : Formatter'Class) return Unbounded_String;
type Simple_Query_Contents is new Query_Contents with record
Command : Ada.Strings.Unbounded.Unbounded_String;
end record;
overriding function To_String
(Self : Simple_Query_Contents;
Format : Formatter'Class) return Unbounded_String;
---------------------
-- Subquery tables --
---------------------
type Subquery_Table is new SQL_Single_Table with record
Query : SQL_Query;
end record;
------------------------------------
-- Null field deferred constants --
------------------------------------
Null_String : aliased constant String := "NULL";
Null_Field_Integer : constant SQL_Field_Integer :=
(Integer_Fields.Null_Field with null record);
Null_Field_Text : constant SQL_Field_Text :=
(Text_Fields.Null_Field with null record);
Null_Field_Boolean : constant SQL_Field_Boolean :=
(Boolean_Fields.Null_Field with null record);
Null_Field_Float : constant SQL_Field_Float :=
(Float_Fields.Null_Field with null record);
Null_Field_Long_Float : constant SQL_Field_Long_Float :=
(Long_Float_Fields.Null_Field with null record);
Null_Field_Money : constant SQL_Field_Money :=
(Money_Fields.Null_Field with null record);
Null_Field_Time : constant SQL_Field_Time :=
(Time_Fields.Null_Field with null record);
Null_Field_Date : constant SQL_Field_Date :=
(Date_Fields.Null_Field with null record);
Null_Field_Bigint : constant SQL_Field_Bigint :=
(Bigint_Fields.Null_Field with null record);
end GNATCOLL.SQL;
|