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