1with AdaBase;
2with Connect;
3with CommonText;
4with Ada.Text_IO;
5with Ada.Calendar;
6with AdaBase.Results.Sets;
7with Interfaces;
8
9procedure Execute_Dynabound is
10
11   package CON renames Connect;
12   package TIO renames Ada.Text_IO;
13   package AR  renames AdaBase.Results;
14   package ARS renames AdaBase.Results.Sets;
15   package CT  renames CommonText;
16   package CAL renames Ada.Calendar;
17
18   package Byte_Io is new Ada.Text_Io.Modular_Io (Interfaces.Unsigned_8);
19
20   type halfbyte is mod 2 ** 4;
21
22   stmt_acc : CON.Stmt_Type_access;
23
24   procedure dump_result;
25   function halfbyte_to_hex (value : halfbyte) return Character;
26   function convert_chain (chain : AR.Chain) return String;
27   function convert_set (set : AR.Settype) return String;
28   function pad (S : String; Slen : Natural) return String;
29   function pad (S : String; Slen : Natural) return String
30   is
31      field : String (1 .. Slen) := (others => ' ');
32      len   : Natural := S'Length;
33   begin
34      field (1 .. len) := S;
35      return field;
36   end pad;
37
38   function halfbyte_to_hex (value : halfbyte) return Character
39   is
40      zero     : constant Natural := Character'Pos ('0');
41      alpham10 : constant Natural := Character'Pos ('A') - 10;
42   begin
43      case value is
44         when 0 .. 9 => return Character'Val (zero + Natural (value));
45         when others => return Character'Val (alpham10 + Natural (value));
46      end case;
47   end halfbyte_to_hex;
48
49   function convert_chain (chain : AR.Chain) return String
50   is
51      use type AR.NByte1;
52      blocks    : constant Natural := chain'Length;
53      mask_ones : constant AR.NByte1 := 16#0F#;
54      work_4bit : halfbyte;
55      result    : String (1 .. blocks * 3 - 1) := (others => ' ');
56      index     : Natural := 0;
57      fullbyte  : Interfaces.Unsigned_8;
58   begin
59      for x in Positive range 1 .. blocks loop
60         index := index + 1;
61         fullbyte := Interfaces.Unsigned_8 (chain (x));
62         fullbyte := Interfaces.Shift_Right (fullbyte, 4);
63         work_4bit := halfbyte (fullbyte);
64         result (index) := halfbyte_to_hex (work_4bit);
65         index := index + 1;
66         work_4bit := halfbyte (chain (x) and mask_ones);
67         result (index) := halfbyte_to_hex (work_4bit);
68         index := index + 1;
69      end loop;
70      if blocks = 0 then
71         return "(empty)";
72      end if;
73      return result;
74   end convert_chain;
75
76   function convert_set (set : AR.Settype) return String
77   is
78      result : CT.Text;
79   begin
80      for x in set'Range loop
81         if not CT.IsBlank (set (x).enumeration) then
82            if x > set'First then
83               CT.SU.Append (result, ",");
84            end if;
85            CT.SU.Append (result, set (x).enumeration);
86         end if;
87      end loop;
88      return CT.USS (result);
89   end convert_set;
90
91   procedure dump_result
92   is
93      row     : ARS.Datarow;
94      numcols : constant Natural := stmt_acc.column_count;
95   begin
96      loop
97         row := stmt_acc.fetch_next;
98         exit when row.data_exhausted;
99         TIO.Put_Line ("");
100         for c in Natural range 1 .. numcols loop
101            TIO.Put (CT.zeropad (c, 2) & ". ");
102            TIO.Put (pad (stmt_acc.column_name (c), 16));
103            TIO.Put (pad (stmt_acc.column_native_type (c)'Img, 15));
104            case stmt_acc.column_native_type (c) is
105               when AdaBase.ft_chain =>
106                  TIO.Put_Line (convert_chain (row.column (c).as_chain));
107               when others =>
108                  TIO.Put_Line (row.column (c).as_string);
109            end case;
110         end loop;
111      end loop;
112      TIO.Put_Line ("");
113   end dump_result;
114
115   cols : constant String := "id_nbyte3, nbyte0, " &
116                             "nbyte1, byte2, byte4, nbyte8, real9, real18, " &
117                             "exact_decimal, my_date, my_timestamp, " &
118                             "my_time, my_year, my_tinytext, enumtype, " &
119                             "settype, my_varbinary, my_blob";
120   sql3 : constant String := "INSERT INTO all_types (" & cols & ") VALUES " &
121                             "(?,?, ?,?,?,?,?,?, ?,?,?, ?,?,?,?, ?,?,?)";
122   sql1 : constant String := "SELECT " & cols & " FROM all_types " &
123                             "WHERE id_nbyte3 > 8";
124
125begin
126
127   CON.connect_database;
128
129   declare
130      numrows : AdaBase.Affected_Rows;
131   begin
132      numrows := CON.DR.execute ("DELETE FROM all_types WHERE id_nbyte3 > 8");
133      if Natural (numrows) > 0 then
134         CON.DR.commit;
135      end if;
136   end;
137
138   declare
139      vals1 : constant String := "20|1|150|-10|-90000|3200100|87.2341|" &
140        "15555.213792831213|875.44|2014-10-20|2000-03-25 15:15:00|" &
141        "20:18:13|1986|AdaBase is so cool!|green|yellow,black|" &
142        " 0123|456789ABC.,z[]";
143      vals2 : constant String := "25;0;200;25;22222;50;4.84324982;" &
144        "9234963.123235987;15.79;1910-11-05;2030-12-25 11:59:59;" &
145        "04:00:45;1945;This is what it sounds like when doves cry;" &
146        "red;blue,white;Q|ER;01234" & Character'Val (0) &
147        Character'Val (10) & "789";
148      good : Boolean := True;
149      stmt : CON.Stmt_Type := CON.DR.prepare (sql3);
150   begin
151      --  This has to be done only once after the prepare command
152      --  Set the type for each parameter (required for at least MySQL)
153      stmt.assign (1,  AR.PARAM_IS_NBYTE_3);
154      stmt.assign (2,  AR.PARAM_IS_BOOLEAN);
155      stmt.assign (3,  AR.PARAM_IS_NBYTE_1);
156      stmt.assign (4,  AR.PARAM_IS_BYTE_2);
157      stmt.assign (5,  AR.PARAM_IS_BYTE_4);
158      stmt.assign (6,  AR.PARAM_IS_NBYTE_8);
159      stmt.assign (7,  AR.PARAM_IS_REAL_9);
160      stmt.assign (8,  AR.PARAM_IS_REAL_18);
161      stmt.assign (9,  AR.PARAM_IS_REAL_9);
162      stmt.assign (10, AR.PARAM_IS_TIMESTAMP);
163      stmt.assign (11, AR.PARAM_IS_TIMESTAMP);
164      stmt.assign (12, AR.PARAM_IS_TIMESTAMP);
165      stmt.assign (13, AR.PARAM_IS_NBYTE_2);
166      stmt.assign (14, AR.PARAM_IS_TEXTUAL);
167      stmt.assign (15, AR.PARAM_IS_ENUM);
168      stmt.assign (16, AR.PARAM_IS_SET);
169      stmt.assign (17, AR.PARAM_IS_CHAIN);
170      stmt.assign (18, AR.PARAM_IS_CHAIN);
171
172      good := stmt.execute (vals1);
173      if good then
174         good := stmt.execute (parameters => vals2, delimiter => ';');
175      end if;
176      if good then
177         CON.DR.commit;
178      else
179         TIO.Put_Line ("statement execution failed");
180         CON.DR.rollback;
181      end if;
182   end;
183
184   declare
185      stmt : aliased CON.Stmt_Type := CON.DR.query (sql1);
186   begin
187      if stmt.successful then
188         stmt_acc := stmt'Unchecked_Access;
189         TIO.Put_Line ("Dumping Result from direct statement ...");
190         dump_result;
191      end if;
192   end;
193
194   declare
195      stmt : aliased CON.Stmt_Type := CON.DR.prepare (sql1);
196   begin
197      if stmt.execute then
198         stmt_acc := stmt'Unchecked_Access;
199         TIO.Put_Line ("Dumping Result from prepared statement ...");
200         dump_result;
201      end if;
202   end;
203
204   TIO.Put_Line ("Note slight differences in real9 and real18 field values");
205   TIO.Put_Line ("due to rounding differences inherent in the different");
206   TIO.Put_Line ("retrieval mechanisms of direct and prep stmt results.");
207
208   CON.DR.disconnect;
209
210end Execute_Dynabound;
211