1-- This file is covered by the Internet Software Consortium (ISC) License 2-- Reference: ../../License.txt 3 4with AdaBase.Interfaces.Connection; 5with AdaBase.Bindings.PostgreSQL; 6with AdaBase.Results; 7with Ada.Containers.Ordered_Maps; 8with Ada.Containers.Vectors; 9with Ada.Unchecked_Deallocation; 10with Ada.Exceptions; 11 12package AdaBase.Connection.Base.PostgreSQL is 13 14 package AIC renames AdaBase.Interfaces.Connection; 15 package BND renames AdaBase.Bindings.PostgreSQL; 16 package AR renames AdaBase.Results; 17 package EX renames Ada.Exceptions; 18 19 type PostgreSQL_Connection is new Base_Connection and AIC.iConnection 20 with private; 21 type PostgreSQL_Connection_Access is access all PostgreSQL_Connection; 22 23 type param_unit is record 24 payload : AR.Textual; 25 binary : Boolean; 26 is_null : Boolean; 27 end record; 28 type parameter_block is array (Positive range <>) of param_unit; 29 30 type postexec_status is (executed, returned_data, failed); 31 32 ----------------------------------------- 33 -- SUBROUTINES REQUIRED BY INTERFACE -- 34 ----------------------------------------- 35 36 overriding 37 procedure connect (conn : out PostgreSQL_Connection; 38 database : String; 39 username : String := blankstring; 40 password : String := blankstring; 41 hostname : String := blankstring; 42 socket : String := blankstring; 43 port : Posix_Port := portless); 44 45 overriding 46 procedure setCompressed (conn : out PostgreSQL_Connection; 47 compressed : Boolean); 48 49 overriding 50 function compressed (conn : PostgreSQL_Connection) return Boolean; 51 52 overriding 53 procedure setUseBuffer (conn : out PostgreSQL_Connection; 54 buffered : Boolean); 55 56 overriding 57 function useBuffer (conn : PostgreSQL_Connection) return Boolean; 58 59 overriding 60 procedure setMultiQuery (conn : out PostgreSQL_Connection; 61 multiple : Boolean); 62 63 overriding 64 function multiquery (conn : PostgreSQL_Connection) return Boolean; 65 66 overriding 67 procedure setAutoCommit (conn : out PostgreSQL_Connection; auto : Boolean); 68 69 overriding 70 function description (conn : PostgreSQL_Connection) return String; 71 72 overriding 73 function SqlState (conn : PostgreSQL_Connection) return SQL_State; 74 75 overriding 76 function driverMessage (conn : PostgreSQL_Connection) return String; 77 78 overriding 79 function driverCode (conn : PostgreSQL_Connection) return Driver_Codes; 80 81 overriding 82 function lastInsertID (conn : PostgreSQL_Connection) return Trax_ID; 83 84 overriding 85 procedure commit (conn : out PostgreSQL_Connection); 86 87 overriding 88 procedure rollback (conn : out PostgreSQL_Connection); 89 90 overriding 91 procedure disconnect (conn : out PostgreSQL_Connection); 92 93 overriding 94 procedure execute (conn : out PostgreSQL_Connection; sql : String); 95 96 overriding 97 function rows_affected_by_execution (conn : PostgreSQL_Connection) 98 return Affected_Rows; 99 100 overriding 101 procedure setTransactionIsolation (conn : out PostgreSQL_Connection; 102 isolation : Trax_Isolation); 103 104 overriding 105 procedure set_character_set (conn : out PostgreSQL_Connection; 106 charset : String); 107 108 overriding 109 function character_set (conn : out PostgreSQL_Connection) return String; 110 111 --------------------------------------------------- 112 -- SUBROUTINES PARTICULAR TO POSTGRESQL DRIVER -- 113 --------------------------------------------------- 114 function SqlState (conn : PostgreSQL_Connection; 115 res : BND.PGresult_Access) 116 return SQL_State; 117 118 procedure discard_pgresult (conn : PostgreSQL_Connection; 119 res : out BND.PGresult_Access); 120 121 function rows_in_result (conn : PostgreSQL_Connection; 122 res : BND.PGresult_Access) 123 return Affected_Rows; 124 125 function rows_impacted (conn : PostgreSQL_Connection; 126 res : BND.PGresult_Access) 127 return Affected_Rows; 128 129 function field_data_is_binary (conn : PostgreSQL_Connection; 130 res : BND.PGresult_Access; 131 column_number : Natural) return Boolean; 132 133 function prepare_statement (conn : PostgreSQL_Connection; 134 stmt : aliased out BND.PGresult_Access; 135 name : String; 136 sql : String) return Boolean; 137 138 function prepare_metadata (conn : PostgreSQL_Connection; 139 meta : aliased out BND.PGresult_Access; 140 name : String) return Boolean; 141 142 function destroy_statement (conn : out PostgreSQL_Connection; 143 name : String) return Boolean; 144 145 function direct_stmt_exec (conn : out PostgreSQL_Connection; 146 stmt : aliased out BND.PGresult_Access; 147 sql : String) return Boolean; 148 149 function fields_count (conn : PostgreSQL_Connection; 150 res : BND.PGresult_Access) return Natural; 151 152 function field_is_null (conn : PostgreSQL_Connection; 153 res : BND.PGresult_Access; 154 row_number : Natural; 155 column_number : Natural) return Boolean; 156 157 function field_length (conn : PostgreSQL_Connection; 158 res : BND.PGresult_Access; 159 row_number : Natural; 160 column_number : Natural) return Natural; 161 162 function field_name (conn : PostgreSQL_Connection; 163 res : BND.PGresult_Access; 164 column_number : Natural) return String; 165 166 function field_type (conn : PostgreSQL_Connection; 167 res : BND.PGresult_Access; 168 column_number : Natural) return field_types; 169 170 function field_table (conn : PostgreSQL_Connection; 171 res : BND.PGresult_Access; 172 column_number : Natural) return String; 173 174 function field_string (conn : PostgreSQL_Connection; 175 res : BND.PGresult_Access; 176 row_number : Natural; 177 column_number : Natural) return String; 178 179 function field_binary (conn : PostgreSQL_Connection; 180 res : BND.PGresult_Access; 181 row_number : Natural; 182 column_number : Natural; 183 max_length : Natural) return String; 184 185 function field_chain (conn : PostgreSQL_Connection; 186 res : BND.PGresult_Access; 187 row_number : Natural; 188 column_number : Natural; 189 max_length : Natural) return String; 190 191 function driverMessage (conn : PostgreSQL_Connection; 192 res : BND.PGresult_Access) return String; 193 194 function driverCode (conn : PostgreSQL_Connection; 195 res : BND.PGresult_Access) return Driver_Codes; 196 197 function markers_found (conn : PostgreSQL_Connection; 198 res : BND.PGresult_Access) return Natural; 199 200 function holds_refcursor (conn : PostgreSQL_Connection; 201 res : BND.PGresult_Access; 202 column_number : Natural) return Boolean; 203 204 function execute_prepared_stmt (conn : PostgreSQL_Connection; 205 name : String; 206 data : parameter_block) 207 return BND.PGresult_Access; 208 209 function execute_prepared_stmt (conn : PostgreSQL_Connection; 210 name : String) return BND.PGresult_Access; 211 212 function examine_result (conn : PostgreSQL_Connection; 213 res : BND.PGresult_Access) 214 return postexec_status; 215 216 function returned_id (conn : PostgreSQL_Connection; 217 res : BND.PGresult_Access) return Trax_ID; 218 219 function select_last_val (conn : PostgreSQL_Connection) return Trax_ID; 220 221 procedure destroy_later (conn : out PostgreSQL_Connection; 222 identifier : Trax_ID); 223 224 ------------------ 225 -- EXCEPTIONS -- 226 ------------------ 227 228 UNSUPPORTED_BY_PGSQL : exception; 229 NOT_WHILE_CONNECTED : exception; 230 DISCONNECT_FAILED : exception; 231 CONNECT_FAILED : exception; 232 AUTOCOMMIT_FAIL : exception; 233 TRAXISOL_FAIL : exception; 234 TRAX_BEGIN_FAIL : exception; 235 ROLLBACK_FAIL : exception; 236 COMMIT_FAIL : exception; 237 QUERY_FAIL : exception; 238 CHARSET_FAIL : exception; 239 METADATA_FAIL : exception; 240 STMT_NOT_VALID : exception; 241 STMT_RESET_FAIL : exception; 242 STMT_FETCH_FAIL : exception; 243 STORED_PROCEDURES : exception; 244 245private 246 247 type table_cell is record 248 column_1 : CT.Text; 249 end record; 250 251 type data_type_rec is record 252 data_type : field_types; 253 end record; 254 255 package table_map is new Ada.Containers.Ordered_Maps 256 (Key_Type => Positive, 257 Element_Type => table_cell); 258 259 package type_map is new Ada.Containers.Ordered_Maps 260 (Key_Type => Positive, 261 Element_Type => data_type_rec); 262 263 package stmt_vector is new Ada.Containers.Vectors 264 (Index_Type => Natural, 265 Element_Type => Trax_ID); 266 267 type PostgreSQL_Connection is new Base_Connection and AIC.iConnection 268 with record 269 info_description : String (1 .. 29) := "PostgreSQL 9.1+ native driver"; 270 prop_multiquery : Boolean := False; 271 dummy : Boolean := False; 272 handle : aliased BND.PGconn_Access := null; 273 cmd_sql_state : SQL_State := stateless; 274 cmd_rows_impact : Affected_Rows := 0; 275 276 -- For last insert id support using INSERT INTO ... RETURNING 277 cmd_insert_return : Boolean := False; 278 insert_return_val : Trax_ID := 0; 279 280 -- Upon connection, dump tables and data types and store them 281 tables : table_map.Map; 282 data_types : type_map.Map; 283 284 -- Upon commit and rollback, deallocate all prep stmts in map 285 stmts_to_destroy : stmt_vector.Vector; 286 end record; 287 288 subtype octet is String (1 .. 3); 289 subtype hexbyte is String (1 .. 2); 290 291 function convert_octet_to_char (before : octet) return Character; 292 function convert_hexbyte_to_char (before : hexbyte) return Character; 293 function is_ipv4_or_ipv6 (teststr : String) return Boolean; 294 function convert_version (pgsql_version : Natural) return CT.Text; 295 function get_library_version return Natural; 296 function convert_data_type (pg_type : String; category : Character; 297 typelen : Integer; encoded_utf8 : Boolean) 298 return field_types; 299 function refined_byte_type (byteX : field_types; constraint : String) 300 return field_types; 301 302 procedure Initialize (conn : in out PostgreSQL_Connection); 303 procedure private_execute (conn : out PostgreSQL_Connection; sql : String); 304 procedure begin_transaction (conn : out PostgreSQL_Connection); 305 procedure cache_table_names (conn : out PostgreSQL_Connection); 306 procedure cache_data_types (conn : out PostgreSQL_Connection); 307 function piped_tables (conn : PostgreSQL_Connection) return String; 308 function get_server_version (conn : PostgreSQL_Connection) return Natural; 309 function get_server_info (conn : PostgreSQL_Connection) return CT.Text; 310 function within_transaction (conn : PostgreSQL_Connection) return Boolean; 311 function connection_attempt_succeeded (conn : PostgreSQL_Connection) 312 return Boolean; 313 function private_select (conn : PostgreSQL_Connection; sql : String) 314 return BND.PGresult_Access; 315 316 procedure free_binary is new Ada.Unchecked_Deallocation 317 (BND.IC.char_array, BND.ICS.char_array_access); 318 319 procedure establish_uniform_encoding (conn : out PostgreSQL_Connection); 320 procedure retrieve_uniform_encoding (conn : out PostgreSQL_Connection); 321 322 overriding 323 procedure finalize (conn : in out PostgreSQL_Connection); 324 325end AdaBase.Connection.Base.PostgreSQL; 326