2011-12-20 09:32:09 +00:00
|
|
|
------------------------------------------------------------------------------
|
|
|
|
|
-- G N A T C O L L --
|
|
|
|
|
-- --
|
2017-01-03 10:05:49 +01:00
|
|
|
-- Copyright (C) 2005-2017, AdaCore --
|
2011-12-20 09:32:09 +00:00
|
|
|
-- --
|
|
|
|
|
-- 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/>. --
|
|
|
|
|
-- --
|
|
|
|
|
------------------------------------------------------------------------------
|
2008-05-06 14:42:03 +00:00
|
|
|
|
|
|
|
|
-- This package instantiates the GNATCOLL.SQL hierarchy for the PostgreSQL
|
|
|
|
|
-- DBMS
|
|
|
|
|
|
2017-09-14 15:17:43 +02:00
|
|
|
with Ada.Strings.Unbounded;
|
2008-05-06 14:42:03 +00:00
|
|
|
with GNATCOLL.SQL.Exec; use GNATCOLL.SQL.Exec;
|
2017-09-14 15:17:43 +02:00
|
|
|
with GNATCOLL.Strings; use GNATCOLL.Strings;
|
2017-02-02 20:46:17 +01:00
|
|
|
with GNATCOLL.SQL.Ranges;
|
2008-05-06 14:42:03 +00:00
|
|
|
|
|
|
|
|
package GNATCOLL.SQL.Postgres is
|
|
|
|
|
|
2011-08-01 13:05:47 +00:00
|
|
|
type Postgres_Description (<>)
|
|
|
|
|
is new Database_Description_Record with private;
|
|
|
|
|
type Postgres_Description_Access is access all Postgres_Description'Class;
|
|
|
|
|
|
|
|
|
|
overriding function Build_Connection
|
2011-08-03 10:56:42 +00:00
|
|
|
(Self : access Postgres_Description) return Database_Connection;
|
2011-08-01 13:05:47 +00:00
|
|
|
|
|
|
|
|
type SSL_Mode is (Disable, Allow, Prefer, Require);
|
|
|
|
|
-- Whether to use SSL to connect to the server. This might not be
|
|
|
|
|
-- applicable to all backends (for instance it doesn't apply to sqlite),
|
|
|
|
|
-- and even if the backend supports SSL, some of the modes might not exist.
|
|
|
|
|
-- Disable => require a non-SSL connection
|
|
|
|
|
-- Allow => first try a non-SSL connection, then SSL if failed
|
|
|
|
|
-- Prefer => first try a SSL connection, then non-SSL if failed
|
|
|
|
|
-- Require => require a SSL connection
|
|
|
|
|
|
|
|
|
|
function Setup
|
|
|
|
|
(Database : String;
|
|
|
|
|
User : String := "";
|
|
|
|
|
Host : String := "";
|
|
|
|
|
Password : String := "";
|
2012-12-18 11:58:29 +00:00
|
|
|
Port : Integer := -1;
|
2011-11-08 14:02:34 +00:00
|
|
|
SSL : SSL_Mode := Allow;
|
2014-03-05 13:41:29 +00:00
|
|
|
Cache_Support : Boolean := True;
|
2017-09-14 15:17:43 +02:00
|
|
|
Errors : access Error_Reporter'Class := null)
|
2011-08-01 13:05:47 +00:00
|
|
|
return Database_Description;
|
2017-11-23 10:29:32 +06:00
|
|
|
-- Return a database description for PostgreSQL.
|
2008-05-07 18:35:46 +00:00
|
|
|
-- If postgres was not detected at installation time, this function will
|
2011-08-01 13:05:47 +00:00
|
|
|
-- return null.
|
2014-03-05 13:41:29 +00:00
|
|
|
-- Errors (if specified) will be used to report errors and warnings to the
|
|
|
|
|
-- application. Errors is never freed.
|
2008-05-06 14:42:03 +00:00
|
|
|
|
2015-09-14 17:04:25 +02:00
|
|
|
function Get_Connection_String
|
|
|
|
|
(Description : Database_Description;
|
|
|
|
|
With_Password : Boolean) return String;
|
|
|
|
|
-- Create a connection string from the database description
|
|
|
|
|
|
2017-05-23 11:31:53 +06:00
|
|
|
----------------------------
|
|
|
|
|
-- Postgres notifications --
|
|
|
|
|
----------------------------
|
|
|
|
|
|
|
|
|
|
type Notification is record
|
|
|
|
|
Channel_Name : XString;
|
|
|
|
|
Notifier_PID : Integer;
|
|
|
|
|
Payload : XString;
|
|
|
|
|
end record;
|
|
|
|
|
|
|
|
|
|
procedure Notifies
|
|
|
|
|
(DB : Database_Connection;
|
|
|
|
|
Message : out Notification;
|
|
|
|
|
Done : out Boolean);
|
|
|
|
|
-- Returns the next notification from a list of unhandled notification
|
|
|
|
|
-- messages received from the backend. Done is set to False if there are
|
|
|
|
|
-- no pending notifications. In this case Message is not be set. If Done
|
|
|
|
|
-- is set to False, Message contains a valid Notification. Once a
|
|
|
|
|
-- notification is returned from Notifies, it is considered handled and
|
|
|
|
|
-- will be removed from the list of notifications.
|
|
|
|
|
|
|
|
|
|
procedure Consume_Input (DB : Database_Connection);
|
|
|
|
|
-- If input is available from the backend, consume it.
|
|
|
|
|
-- Note that the result does not say whether any input
|
|
|
|
|
-- data was actually collected. After calling Consume_Input, the
|
|
|
|
|
-- application may check Is_Busy and/or Notifies to see if their state
|
|
|
|
|
-- has changed.
|
|
|
|
|
--
|
|
|
|
|
-- Consume_Input may be called even if the application is not prepared to
|
|
|
|
|
-- deal with a result or notification just yet. The routine will read
|
|
|
|
|
-- available data and save it in a buffer, thereby causing a select(2)
|
|
|
|
|
-- read-ready indication to go away. The application can thus use
|
|
|
|
|
-- Consume_Input to clear the select condition immediately, and then
|
|
|
|
|
-- examine the results at leisure.
|
|
|
|
|
|
|
|
|
|
function Wait_For_Input
|
|
|
|
|
(DB : Database_Connection;
|
|
|
|
|
Timeout : Duration := Duration'Last) return Boolean;
|
|
|
|
|
-- Waiting for available input and return False on timeout or True on
|
|
|
|
|
-- success. No need to call Consume_Input afterward, it is already called
|
|
|
|
|
-- internally on wait success.
|
|
|
|
|
|
2008-05-06 14:42:03 +00:00
|
|
|
-------------------------
|
|
|
|
|
-- Postgres extensions --
|
|
|
|
|
-------------------------
|
2013-09-23 12:45:46 +00:00
|
|
|
|
2008-05-06 14:42:03 +00:00
|
|
|
-- Postgres-specific extensions for GNATCOLL.SQL
|
|
|
|
|
|
|
|
|
|
function OID_Field (Table : SQL_Table'Class) return SQL_Field_Integer;
|
|
|
|
|
-- The object identifier field, available in each table. This is postgres
|
|
|
|
|
-- specific. It can be used for instance to retrieve the newly inserted
|
|
|
|
|
-- row in a table, by retrieving the OID of the previous result.
|
2008-05-15 10:16:39 +00:00
|
|
|
-- With recent versions of PostgreSQL, you must explicitly create the table
|
|
|
|
|
-- with support for oids ("CREATE TABLE (...) WITH OIDS"), otherwise the
|
|
|
|
|
-- oid will always be null. For this reason, and since oids slow things
|
|
|
|
|
-- done a little, and take space, it is not recommended to depend on them.
|
2008-05-06 14:42:03 +00:00
|
|
|
|
2009-05-29 02:03:16 +00:00
|
|
|
function Now is new Time_Fields.SQL_Function ("now()");
|
2009-05-27 17:41:02 +00:00
|
|
|
-- Return the current timestamp, same as Current_Timestamp
|
|
|
|
|
|
2012-01-05 16:11:08 +00:00
|
|
|
function Regexp
|
|
|
|
|
(Self : Text_Fields.Field'Class;
|
|
|
|
|
Str : String) return SQL_Criteria;
|
|
|
|
|
-- Check whether the field matches a regular expression. This is the "~*"
|
|
|
|
|
-- operator specific to postgreSQL.
|
|
|
|
|
|
2013-09-23 12:45:46 +00:00
|
|
|
-- Generic query extensions
|
|
|
|
|
|
|
|
|
|
type SQL_PG_Extension is abstract tagged private;
|
2017-09-14 15:17:43 +02:00
|
|
|
function To_String
|
|
|
|
|
(Self : SQL_PG_Extension; Format : Formatter'Class)
|
|
|
|
|
return Ada.Strings.Unbounded.Unbounded_String is abstract;
|
2013-09-23 12:45:46 +00:00
|
|
|
|
|
|
|
|
function Returning (Fields : SQL_Field_List) return SQL_PG_Extension'Class;
|
|
|
|
|
-- RETURNING clause for UPDATE query
|
|
|
|
|
|
|
|
|
|
function For_Update
|
|
|
|
|
(Tables : SQL_Table_List := Empty_Table_List;
|
|
|
|
|
No_Wait : Boolean := False) return SQL_PG_Extension'Class;
|
|
|
|
|
-- FOR UPDATE clause for SELECT query
|
|
|
|
|
|
|
|
|
|
function "&"
|
|
|
|
|
(Query : SQL_Query;
|
|
|
|
|
Extension : SQL_PG_Extension'Class) return SQL_Query;
|
2015-05-28 09:49:18 +02:00
|
|
|
-- Extends an existing query with postgres-specific additions. For
|
|
|
|
|
-- instance:
|
|
|
|
|
-- R.Fetch (DB, SQL_Select (...) & Returning (Field1));
|
2013-09-23 12:45:46 +00:00
|
|
|
|
2017-09-14 15:17:43 +02:00
|
|
|
package DateRanges is new GNATCOLL.SQL.Ranges
|
2017-02-20 11:25:30 +01:00
|
|
|
(Base_Fields => GNATCOLL.SQL.Date_Fields,
|
|
|
|
|
SQL_Type => "daterange",
|
|
|
|
|
Ada_Field_Type => "GNATCOLL.SQL.Postgres.SQL_Field_Date_Range");
|
2017-09-14 15:17:43 +02:00
|
|
|
subtype Date_Range is DateRanges.Ada_Range;
|
|
|
|
|
subtype SQL_Field_Date_Range is DateRanges.SQL_Field_Range;
|
2017-02-02 20:46:17 +01:00
|
|
|
|
2017-09-14 15:17:43 +02:00
|
|
|
package NumRanges is new GNATCOLL.SQL.Ranges
|
|
|
|
|
(Base_Fields => GNATCOLL.SQL.Float_Fields,
|
2017-02-20 11:25:30 +01:00
|
|
|
SQL_Type => "numrange",
|
|
|
|
|
Ada_Field_Type => "GNATCOLL.SQL.Postgres.SQL_Field_Num_Range");
|
2017-09-14 15:17:43 +02:00
|
|
|
subtype Num_Range is NumRanges.Ada_Range;
|
|
|
|
|
type SQL_Field_Num_Range is
|
|
|
|
|
new NumRanges.SQL_Field_Range with null record;
|
2017-02-02 20:46:17 +01:00
|
|
|
|
2017-09-14 15:17:43 +02:00
|
|
|
package IntegerRanges is new GNATCOLL.SQL.Ranges
|
2017-02-20 11:25:30 +01:00
|
|
|
(Base_Fields => GNATCOLL.SQL.Integer_Fields,
|
|
|
|
|
SQL_Type => "int4range",
|
|
|
|
|
Ada_Field_Type => "GNATCOLL.SQL.Postgres.SQL_Field_Integer_Range");
|
2017-09-14 15:17:43 +02:00
|
|
|
subtype Integer_Range is IntegerRanges.Ada_Range;
|
|
|
|
|
type SQL_Field_Integer_Range is
|
|
|
|
|
new IntegerRanges.SQL_Field_Range with null record;
|
2017-02-02 20:46:17 +01:00
|
|
|
|
2017-09-14 15:17:43 +02:00
|
|
|
package BigintRanges is new GNATCOLL.SQL.Ranges
|
2017-02-20 11:25:30 +01:00
|
|
|
(Base_Fields => GNATCOLL.SQL.Bigint_Fields,
|
|
|
|
|
SQL_Type => "int8range",
|
|
|
|
|
Ada_Field_Type => "GNATCOLL.SQL.Postgres.SQL_Field_Bigint_Range");
|
2017-09-14 15:17:43 +02:00
|
|
|
subtype Bigint_Range is BigintRanges.Ada_Range;
|
|
|
|
|
type SQL_Field_Bigint_Range is
|
|
|
|
|
new BigintRanges.SQL_Field_Range with null record;
|
2017-02-02 20:46:17 +01:00
|
|
|
|
2011-08-01 13:05:47 +00:00
|
|
|
private
|
2014-03-05 13:41:29 +00:00
|
|
|
type Postgres_Description is new Database_Description_Record with record
|
2017-07-17 11:42:59 +02:00
|
|
|
Host : GNATCOLL.Strings.XString;
|
|
|
|
|
Dbname : GNATCOLL.Strings.XString;
|
|
|
|
|
User : GNATCOLL.Strings.XString;
|
|
|
|
|
Password : GNATCOLL.Strings.XString;
|
|
|
|
|
SSL : SSL_Mode := Prefer;
|
|
|
|
|
Port : Integer := -1;
|
2011-08-01 13:05:47 +00:00
|
|
|
end record;
|
|
|
|
|
|
2013-09-23 12:45:46 +00:00
|
|
|
type SQL_PG_Extension is abstract tagged null record;
|
2015-05-28 09:49:18 +02:00
|
|
|
type SQL_PG_Extension_Access is access all SQL_PG_Extension'Class;
|
2013-09-23 12:45:46 +00:00
|
|
|
|
2008-05-06 14:42:03 +00:00
|
|
|
end GNATCOLL.SQL.Postgres;
|