File: gnatcoll-sql-orm.adb

package info (click to toggle)
libgnatcoll-db 18-4
  • links: PTS
  • area: main
  • in suites: buster
  • size: 2,268 kB
  • sloc: ada: 23,786; python: 2,166; makefile: 486; sh: 34; ansic: 18
file content (126 lines) | stat: -rw-r--r-- 3,276 bytes parent folder | download
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
------------------------------------------------------------------------------
--                                   CRM                                    --
--                    [Customer Relationship Management]                    --
--                                                                          --
--                         Copyright (C) 2009-2018, AdaCore                 --
------------------------------------------------------------------------------

package body GNATCOLL.SQL.Orm is

   --------------
   -- Order_By --
   --------------

   procedure Order_By (Self : in out Manager'Class; By : SQL_Field_List) is
   begin
      Self.Order_By := By;
   end Order_By;

   --------------
   -- Order_By --
   --------------

   procedure Order_By (Self : in out Manager'Class; By : SQL_Field'Class) is
   begin
      Self.Order_By := +By;
   end Order_By;

   -----------
   -- Limit --
   -----------

   procedure Limit
     (Self : in out Manager'Class; Count : Natural; From : Natural := 0)
   is
   begin
      Self.Limit_Count := Count;
      Self.Offset := From;
   end Limit;

   --------------
   -- Distinct --
   --------------

   procedure Distinct (Self : in out Manager'Class) is
   begin
      Self.Distinct := True;
   end Distinct;

   --------------------
   -- Select_Related --
   --------------------

   procedure Select_Related
      (Self  : in out Manager'Class;
       Depth : Natural;
       Follow_Left_Join : Boolean := False)
   is
   begin
      Self.Select_Related := Depth;
      Self.Follow_LJ      := Follow_Left_Join;
   end Select_Related;

   --------------------
   -- Select_Related --
   --------------------

   function Select_Related (Self : Manager'Class) return Natural is
   begin
      return Self.Select_Related;
   end Select_Related;

   ------------
   -- Filter --
   ------------

   procedure Filter (Self : in out Manager'Class; Condition : SQL_Criteria) is
   begin
      Self.Where := Self.Where and Condition;
   end Filter;

   -----------
   -- Query --
   -----------

   procedure Query (Self   : Manager'Class;
                    Query  : out SQL_Query;
                    Fields : SQL_Field_List;
                    From   : SQL_Table_List;
                    Criteria : SQL_Criteria := No_Criteria) is
   begin
      Query := SQL_Select
        (Fields   => Fields,
         From     => From,
         Where    => Self.Where and Criteria,
         Order_By => Self.Order_By,
         Limit    => Self.Limit_Count,
         Offset   => Self.Offset,
         Distinct => Self.Distinct);
      Auto_Complete (Query);
   end Query;

   ----------
   -- Copy --
   ----------

   procedure Copy (Self : Manager'Class; Into : in out Manager'Class) is
   begin
      Into.Where          := Self.Where;
      Into.Order_By       := Self.Order_By;
      Into.Limit_Count    := Self.Limit_Count;
      Into.Offset         := Self.Offset;
      Into.Distinct       := Self.Distinct;
      Into.Select_Related := Self.Select_Related;
      Into.Follow_LJ      := Self.Follow_LJ;
   end Copy;

   ---------------
   -- Follow_LJ --
   ---------------

   function Follow_LJ (Self : Manager'Class) return Boolean is
   begin
      return Self.Follow_LJ;
   end Follow_LJ;

end GNATCOLL.SQL.Orm;