ada/gnatcoll-db
0
0
Fork 0
mirror of https://github.com/AdaCore/gnatcoll-db.git synced 2026-02-12 12:59:31 -08:00
Code Issues Packages Projects Releases Wiki Activity
Files
master
gnatcoll-db/postgres/gnatcoll-sql-postgres-gnade.ads
anisimko 0819d68de5 Remove unused package references 
no-tn-check

GNAT style check became more strict.

Change-Id: I24b59f7b3ffdfa58d8a54b3ede6bfa56fbdcc46d
2020-09-14 11:12:41 +06:00

631 lines
28 KiB
Ada
Raw Permalink Blame History

-------------------------------------------------------------------------------
-- --
-- GNADE : GNu Ada Database Environment --
-- --
-- Copyright (C) 2000-2003, Juergen Pfeifer <juergen.pfeifer@gmx.net> --
-- Copyright (C) 2004-2020, AdaCore --
-- --
-- GNADE is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License along with this program; see file COPYING. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNADE is implemented to work with GNAT, the GNU Ada compiler. --
-------------------------------------------------------------------------------
-- This file is adapted from the GNADE package, with local changes, in
-- particular in the namespace.
-- This binding is not intended to provide a Layer that hides the details
-- of PostgreSQL, instead the opposite is intended. This binding exposes
-- the same functionality as the C interface libpq.
--
-- It contains the low-level binding to the postgreSQL library, and is not
-- recommended for end users (the higher-level API in GNATCOLL.SQL is easier
-- to use, more portable across DBMS and provides type-safety). However, this
-- package can be used to provide an easier transition of existing code to
-- the higher-level API.
with Ada.Finalization;
with Interfaces.C.Strings;
with GNATCOLL.SQL_Impl;
with System;
package GNATCOLL.SQL.Postgres.Gnade is
PostgreSQL_Error : exception;
NAMEDATALEN : constant := 32;
-- The maximum length for system identifiers (e.g. table names etc.)
type OID is new Interfaces.C.unsigned;
-- PostreSQL assigns a unique Object ID (OID) to a row.
InvalidOID : constant OID;
-- This denotes an invalid OID.
subtype TypeID is OID;
-- Types are objects in the database and have IDs.
InvalidTypeID : constant TypeID;
type Field_Index is new Natural;
-- Field indices in general start with 0 in PostgreSQL
type Tuple_Index is new Natural;
-- Tuple indices in general start with 0 in PostgreSQL
type ConnStatus is (CONNECTION_OK,
CONNECTION_BAD,
CONNECTION_STARTED,
CONNECTION_MADE,
CONNECTION_AWAITING_RESPONSE,
CONNECTION_AUTH_OK,
CONNECTION_SETENV);
pragma Convention (C, ConnStatus);
subtype SynchConnStatus is
ConnStatus range CONNECTION_OK .. CONNECTION_BAD;
-- These values are possible for synchronous connections.
type Backend_PID is new Interfaces.C.int;
-- This type is used to identify the backend server process handling the
-- database connection.
type ExecStatus is (
-- Direct mappings for C values
PGRES_EMPTY_QUERY,
PGRES_COMMAND_OK,
PGRES_TUPLES_OK,
PGRES_COPY_OUT,
PGRES_COPY_IN,
PGRES_BAD_RESPONSE,
PGRES_NONFATAL_ERROR,
PGRES_FATAL_ERROR,
PGRES_COPY_BOTH,
-- Additional value denoting a NULL PQresult
PGRES_Null_Result);
pragma Convention (C, ExecStatus);
type Database (Parameters : access String) is tagged limited private;
-- You must pass the PostgreSQL connection string as discriminant
-- when you instantiate a new Database object. The connection to
-- the database will be made during the initialization of the object.
-- The connection will be closed automatically when the Database objects
-- goes out of scope (will be "finalized").
procedure Reset (DB : Database'Class);
pragma Inline (Reset);
-- This function will close the connection to the backend and attempt
-- to reestablish a new connection to the same postmaster, using all
-- the same parameters previously used. This may be useful for error
-- recovery if a working connection is lost.
function Name (DB : Database'Class) return String;
pragma Inline (Name);
-- Returns the database name of the connection
function User (DB : Database'Class) return String;
pragma Inline (User);
-- Returns the user name of the connection
function Password (DB : Database'Class) return String;
pragma Inline (Password);
-- Returns the password of the connection
function Host (DB : Database'Class) return String;
pragma Inline (Host);
-- Returns the server host name of the connection
function Port (DB : Database'Class) return String;
pragma Inline (Port);
-- Returns the port of the connection
function TTY (DB : Database'Class) return String;
pragma Inline (TTY);
-- Returns the debug tty of the connection
function Options (DB : Database'Class) return String;
pragma Inline (Options);
-- Returns the backend options used in the connection
function Error (DB : Database'Class) return String;
pragma Inline (Error);
-- Returns the error message most recently generated by an operation
-- on the connection
function Server_PID (DB : Database'Class) return Backend_PID;
pragma Inline (Server_PID);
-- Returns the process ID of the backend server handling this connection
function Status (DB : Database'Class) return ConnStatus;
pragma Inline (Status);
-- Returns the status of the connection.
-- Only two of the ConnStatus values are seen outside of an asynchronous
-- connection procedure - CONNECTION_OK or CONNECTION_BAD. A good
-- connection to the database has the status CONNECTION_OK. A failed
-- connection attempt is signaled by status CONNECTION_BAD. Ordinarily,
-- an OK status will remain so until PQfinish, but a communications
-- failure might result in the status changing to CONNECTION_BAD
-- prematurely. In that case the application could try to recover by
-- calling the Reset procedure.
-- -----------------------------------------------------------------------
-- Management of Large Objects (BLOBs)
-- Cf http://www.postgresql.org/docs/current/interactive/lo-interfaces.html
-- (Added by Audran Le Baron <lebaron@act-europe.fr>)
-- -----------------------------------------------------------------------
type File_Mode is mod 16#100000000#;
for File_Mode'Size use Integer'Size;
INV_WRITE : constant File_Mode := 16#00020000#;
INV_READ : constant File_Mode := 16#00040000#;
type File_Descriptor is new Integer;
Invalid_FD : constant File_Descriptor := -1;
Seek_Set : constant := 0;
Seek_Cur : constant := 1;
Seek_End : constant := 2;
function BLOB_Create (DB : Database'Class;
Mode : File_Mode)
return OID;
pragma Inline (BLOB_Create);
-- Create a Large Object. Read and write modes can be combined by OR'ing
-- the correspondant flags. Return the OID of the newly created BLOB.
-- Oid lo_creat (PGconn *conn, int mode)
function BLOB_Import (DB : Database'Class;
In_File_Name : String) return OID;
pragma Inline (BLOB_Import);
-- Import a Large Object into the database
-- and return the corresponding OID.
-- Oid lo_import(PGconn *conn, const char *filename)
function BLOB_Export (DB : Database'Class;
Object_Id : OID;
Out_File_Name : String) return Boolean;
pragma Inline (BLOB_Export);
-- Export the given Large Object from the database to the specified file.
-- Return False upon error, True otherwise.
-- int lo_export(PGconn *conn, Oid lobjId, const char *filename)
function BLOB_Open (DB : Database'Class;
Object_Id : OID;
Mode : File_Mode)
return File_Descriptor;
pragma Inline (BLOB_Open);
-- Open the given BLOB. Return the corresponding file descriptor.
-- int lo_open (PGconn *conn, Oid lobjId, int mode)
function BLOB_Write (DB : Database'Class;
FD : File_Descriptor;
A : System.Address;
N : Integer)
return Integer;
pragma Inline (BLOB_Write);
-- Write N bytes from A to large object FD.
-- Return the number of bytes actually written.
-- int lo_write (PGconn *conn, int fd, const char *buf, size_t len)
function BLOB_Read (DB : Database'Class;
FD : File_Descriptor;
A : System.Address;
N : Integer)
return Integer;
pragma Inline (BLOB_Read);
-- Read N bytes from large object FD to A.
-- Return the number of bytes actually read.
-- int lo_read (PGconn *conn, int fd, char *buf, size_t len)
function BLOB_Lseek (DB : Database'Class;
FD : File_Descriptor;
Offset : Integer;
Origin : Integer)
return Integer;
pragma Inline (BLOB_Lseek);
-- Move the current location pointer for the large object FD
-- to the new location specified by offset.
-- The valid values for Origin are:
-- SEEK_SET (seek from object start),
-- SEEK_CUR (seek from current position),
-- SEEK_END (seek from object end).
-- Return the new location pointer.
-- int lo_lseek (PGconn *conn, int fd, int offset, int whence)
function BLOB_Tell (DB : Database'Class;
FD : File_Descriptor)
return Integer;
pragma Inline (BLOB_Tell);
-- Return the current read or write location of large object FD.
-- If there is an error, the return value is negative.
-- int lo_tell (PGconn *conn, int fd)
function BLOB_Close (DB : Database'Class;
FD : File_Descriptor)
return Boolean;
pragma Inline (BLOB_Close);
-- Close the given large object (FD).
-- Return True upon success, False otherwise.
-- int lo_close (PGconn *conn, int fd)
function BLOB_Unlink (DB : Database'Class;
Object_Id : OID) return Boolean;
pragma Inline (BLOB_Unlink);
-- Remove the given Large Object from the database.
-- Return True upon success, False otherwise.
-- int lo_unlink(PGconn *conn, Oid lobjId)
type Result is private;
-- This is the abstraction of a query result set.
-- You must call Clear to free the contents once you no longer need it
procedure Clear (Res : in out Result);
-- Free the memory used by Result
procedure Execute
(Res : in out Result;
DB : Database'Class;
Query : String;
Format : GNATCOLL.SQL_Impl.Formatter'Class;
Params : SQL_Parameters := No_Parameters);
-- Submit a query to Postgres and wait for the result
procedure Prepare
(Res : out Result;
DB : Database'Class;
Stmt_Name : String;
Query : String);
-- Prepare the statement for execution
procedure Exec_Prepared
(Res : out Result;
DB : Database'Class;
Stmt_Name : String;
Format : GNATCOLL.SQL_Impl.Formatter'Class;
Params : SQL_Parameters := No_Parameters);
-- Execute a prepared statement
function Status (Res : Result) return ExecStatus;
-- Returns the result status of the query
-- If the result status is PGRES_TUPLES_OK, then the routines described
-- below can be used to retrieve the tuples returned by the query.
-- Note that a SELECT that happens to retrieve zero tuples still shows
-- PGRES_TUPLES_OK. PGRES_COMMAND_OK is for commands that can never
-- return tuples (INSERT, UPDATE, etc.). A response of PGRES_EMPTY_QUERY
-- often exposes a bug in the client software.
function Status (Status : ExecStatus) return String;
-- Converts the enumerated type returned by PQresultStatus into a
-- string constant describing the status code
function Status (Res : Result) return String;
pragma Inline (Status);
-- Combination of the above two elementary functions. Get the string
-- constant describing the status code directly from the Result
function Error (Res : Result) return String;
pragma Inline (Error);
-- Returns the error message associated with the query, or an empty
-- string if there was no error.
--
-- Immediately following an Execute or GetResult call, Error (on the
-- Database object) will return the same string as Error (on the Result).
-- However, a Result will retain its error message until destroyed,
-- whereas the Database's error message will change when subsequent
-- operations are done. Use Error (on the Result) when you want to know
-- the status associated with a particular Result; use Error (on the
-- Database) when you want to know the status from the latest operation
-- on the connection.
function Tuple_Count (Res : Result) return Tuple_Index;
pragma Inline (Tuple_Count);
-- Returns the number of tuples (instances) in the query result
function Field_Count (Res : Result) return Field_Index;
pragma Inline (Field_Count);
-- Returns the number of fields (attributes) in each tuple of the
-- query result
function Field_Name (Res : Result;
Index : Field_Index) return String;
pragma Inline (Field_Name);
-- Returns the field (attribute) name associated with the given field
-- index.
procedure Field_Lookup (Res : Result;
Name : String;
Index : out Field_Index;
Found : out Boolean);
pragma Inline (Field_Lookup);
-- Returns the field (attribute) index associated with the given
-- field name. If the field was found, the 'Found' parameter is set
-- to True and the 'Index' parameter will contain the fields index.
-- Otherwise 'Found' is set to False.
function Is_Binary (Res : Result) return Boolean;
pragma Inline (Is_Binary);
-- Returns True if the Result contains binary tuple data, False if it
-- contains ASCII data.
function Field_Type (Res : Result;
Index : Field_Index) return TypeID;
pragma Inline (Field_Type);
-- Returns the field type associated with the given field index.
-- The TypeID returned is an internal coding of the type.
procedure Value (Res : Result;
Tuple : Tuple_Index;
Field : Field_Index;
Pointer : out System.Address);
-- For most queries, the value referenced by Pointer is a C-String
-- representation of the attribute value. But if Is_Binary is True,
-- the value referenced by Pointer is the binary representation of the type
-- in the internal format of the backend server. It is then the
-- programmer's responsibility to cast and convert the data to the
-- correct Ada type. The Pointer returned points to storage that
-- is part of the Result object. One should not modify it, and one
-- must explicitly copy the value into other storage if it is to be
-- used past the lifetime of the Result object itself.
function C_Value
(Res : Result;
Tuple : Tuple_Index := 0;
Field : Field_Index := 0) return Interfaces.C.Strings.chars_ptr;
-- Returns the C string
function Value (Res : Result;
Tuple : Tuple_Index := 0;
Field : Field_Index := 0) return String;
-- Returns a single field (attribute) value of one tuple of a Result
-- as a String. If this is a binary field please use the more general
-- Value procedure above.
function Boolean_Value (Res : Result;
Tuple : Tuple_Index := 0;
Field : Field_Index := 0) return Boolean;
pragma Inline (Boolean_Value);
-- Same as above, but returns a boolean
function Value (Res : Result;
Tuple : Tuple_Index := 0;
Field_Name : String) return String;
-- Returns a single field (attribute) value of one tuple of a Result
-- as a String. If this is a binary field please use the more general
-- Value procedure above.
pragma Inline (Value);
function Boolean_Value (Res : Result;
Tuple : Tuple_Index := 0;
Field_Name : String) return Boolean;
pragma Inline (Boolean_Value);
-- Same as above but returns a boolean
function Integer_Value (Res : Result;
Tuple : Tuple_Index := 0;
Field : Field_Index := 0;
Default : Integer := Integer'First) return Integer;
pragma Inline (Integer_Value);
-- Same as above but returns an integer.
-- If the field does not contain an integer, Default is returned if it
-- was specified, or an exception is raised otherwise.
function Array_Field (Value : String; Field : Positive) return String;
-- Given a postgres array value "{1, 2, 3}", return the Index-th value.
-- Constraint_Error is raised upon reaching the end of the array
function Field_Size (Res : Result;
Field : Field_Index) return Integer;
pragma Inline (Field_Size);
-- Returns the size in bytes of the field associated with the given
-- field index.
-- Field_Size returns the space allocated for this field in a database
-- tuple, in other words the size of the server's binary representation
-- of the data type. -1 is returned if the field is variable size.
function Field_Modification (Res : Result;
Field : Field_Index) return Integer;
pragma Inline (Field_Modification);
-- Returns the type-specific modification data of the field associated
-- with the given field index.
function Field_Length (Res : Result;
Tuple : Tuple_Index;
Field : Field_Index) return Natural;
pragma Inline (Field_Length);
-- Returns the length of a field (attribute) in bytes.
-- This is the actual data length for the particular data value, that is
-- the size of the object retrieved by the Value function. Note that for
-- ASCII-represented values, this size has little to do with the binary
-- size reported by Field_Size.
function Is_Null (Res : Result;
Tuple : Tuple_Index;
Field : Field_Index) return Boolean;
pragma Inline (Is_Null);
-- Tests a field for a NULL entry. This function returns True if the
-- field contains a NULL, False if it contains a non-null value.
-- (Note that the Value function will return an empty string for a NULL
-- field.)
function Command_Status (Res : Result) return String;
pragma Inline (Command_Status);
-- Returns the command status string from the SQL command that generated
-- the Result.
function Command_Tuples (Res : Result) return String;
pragma Inline (Command_Tuples);
-- Returns the number of rows affected by the SQL command.
-- If the SQL command that generated the Result was INSERT, UPDATE or
-- DELETE, this returns a string containing the number of rows affected.
-- If the command was anything else, it returns the empty string
function Command_Tuples (Res : Result) return Natural;
pragma Inline (Command_Tuples);
-- Returns the number of rows affected by the SQL command.
-- If the SQL command that generated the Result was INSERT, UPDATE or
-- DELETE, this returns the number of rows affected.
-- If the command was anything else, it returns 0.
function OID_Value (Res : Result) return OID;
pragma Inline (OID_Value);
-- Returns the object id of the tuple inserted, if the SQL command was
-- an INSERT. Otherwise, returns InvalidOid.
procedure Make_Empty_Result (Res : out Result;
DB : Database'Class;
Status : ExecStatus := PGRES_EMPTY_QUERY);
-- Constructs an empty Result object with the given status
-- This is libpq's internal routine to allocate and initialize an empty
-- Result object. It is exported because some applications find it useful
-- to generate result objects (particularly objects with error status)
-- themselves. If the Database connection is valid and status indicates
-- an error, the connection's current errorMessage is copied into the
-- Result.
pragma Inline (Make_Empty_Result);
-- -----------------------------------------------------------------------
-- Procedures and functions for Asynchronous query processing
-- -----------------------------------------------------------------------
function Is_Non_Blocking (DB : Database'Class) return Boolean;
pragma Inline (Is_Non_Blocking);
-- Returns the blocking status of the database connection.
function Send_Query (DB : Database'Class;
Query : String) return Boolean;
pragma Inline (Send_Query);
-- Submit a query to Postgres without waiting for the result(s). True is
-- returned if the query was successfully dispatched, False if not (in
-- which case, use function Error to get more information about the
-- failure).
-- After successfully calling Send_Query, call Get_Result one or more
-- times to obtain the query results. Send_Query may not be called again
-- (on the same connection) until Get_Result has returned with completion
-- flag set to True, indicating that the query is done.
procedure Get_Result (DB : Database'Class;
Res : out Result;
Done : out Boolean);
-- Wait for the next result from a prior Send_Query, and return it.
-- Done is set to True when the query is complete and there will be no
-- more results, in this case Res will not be set. When Done is set to
-- False, the Res contains a Result and processing is not finished.
function Consume_Input (DB : Database'Class) return Boolean;
pragma Inline (Consume_Input);
-- If input is available from the backend, consume it.
-- Consume_Input normally returns True indicating "no error", but returns
-- False if there was some kind of trouble (in which case function Error
-- should be used). 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 Flush (DB : Database'Class) return Boolean;
pragma Inline (Flush);
-- Attempt to flush any data queued to the backend, returns True if
-- successful (or if the send queue is empty) or False if it failed for
-- some reason.
-- Flush needs to be called on a non-blocking connection before calling
-- select to determine if a responce has arrived. If True is returned it
-- ensures that there is no data queued to the backend that has not
-- actually been sent. Only applications that have used Set_Non_Blocking
-- have a need for this.
function Is_Busy (DB : Database'Class) return Boolean;
pragma Inline (Is_Busy);
-- Returns True if a query is busy, that is, Get_Result would block
-- waiting for input. A False return indicates that Get_Result can be
-- called with assurance of not blocking.
-- Is_Busy will not itself attempt to read data from the backend;
-- therefore Consume_Input must be invoked first, or the busy state will
-- never end.
function Socket (DB : Database'Class) return Interfaces.C.int;
pragma Inline (Socket);
-- Obtain the file descriptor number for the backend connection socket.
-- A valid descriptor will be >= 0; a result of -1 indicates that no
-- backend connection is currently open.
function Request_Cancel (DB : Database'Class) return Boolean;
pragma Inline (Request_Cancel);
-- Request that Postgres abandon processing of the current query.
-- The return value is True if the cancel request was successfully
-- dispatched, False if not. (If not, function Error tells why not.)
-- Successful dispatch is no guarantee that the request will have any
-- effect, however. Regardless of the return value of Request_Cancel,
-- the application must continue with the normal result-reading sequence
-- using Get_Result. If the cancellation is effective, the current query
-- will terminate early and return an error result. If the cancellation
-- fails (say, because the backend was already done processing the query),
-- then there will be no visible result at all.
-- Note that if the current query is part of a transaction, cancellation
-- will abort the whole transaction.
-- Request_Cancel can safely be invoked from a signal handler. So, it is
-- also possible to use it in conjunction with plain Execute, if the
-- decision to cancel can be made in a signal handler. Note that
-- Request_Cancel will have no effect if the connection is not currently
-- open or the backend is not currently processing a query.
procedure Notifies (DB : Database'Class;
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.
function Quote_Identifier (Identifier : String) return String;
pragma Inline (Quote_Identifier);
private
use Ada.Finalization;
InvalidOID : constant OID := 0;
InvalidTypeID : constant TypeID := TypeID (InvalidOID);
type PGconnection is new System.Address;
Null_Connection : constant PGconnection :=
PGconnection (System.Null_Address);
function Connect (Params : access String) return PGconnection;
type Database (Parameters : access String) is new Limited_Controlled with
record
Connection : PGconnection := Connect (Parameters);
end record;
overriding procedure Finalize (Object : in out Database);
type PGresult is new System.Address;
Null_Result : constant PGresult := PGresult (System.Null_Address);
type Result is record
Res : PGresult := Null_Result;
end record;
end GNATCOLL.SQL.Postgres.Gnade;
Reference in New Issue View Git Blame Copy Permalink