Re: Call for review: Database API for the GNADE Project

[jukano@visto.com (Julio Cano)]

This is what I did time ago. It's not finished nor completed but it
works for little examples. The first version was made in C to access
PostgresQL so y called it "pgrecordset", but the table it returns is
not dynamc (can't be modified).
Actualy is in Ada and uses GNADE odbc.
It may look like MS DAO too, but if it's usefull....
The main ads is:

---------------------
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;

with Data_Bind;
use Data_Bind;

generic
   Conninfo : String;
   Username : String := "";
   Passwd : String := "";
package PGRecordset is

   type Pgrecordset_ptr is private;
--   type String_Access is access all String;

   NO_DATA : exception;
   DATABASE_ERROR : exception;

   function Get_Bind_List (Recordset : Pgrecordset_Ptr) return
Base_Data;
   procedure Set_Bind_List (Recordset : in out Pgrecordset_Ptr; List :
Base_Data);

   procedure Registerdata (Recordset: Pgrecordset_Ptr; Str:
String_Access; Field : String);

   function First_Field (Recordset : Pgrecordset_Ptr) return Integer;
   function Last_Field (Recordset : Pgrecordset_Ptr) return Integer;

   procedure MoveFirst (Recordset : Pgrecordset_Ptr);
   procedure MoveNext (Recordset : Pgrecordset_Ptr);

   function Recordset_New(Conninfo : String; Username : String := "";
Passwd : String := "") return Pgrecordset_ptr;
   procedure recordset_Close(recordset : in out Pgrecordset_Ptr);
   -- Theese handle new connexions

   function Recordset_New return Pgrecordset_ptr;
   procedure recordset_Close;
   -- Theese handle default conx. so that new conx. doesn't have to be
created.

   function error (Recordset : Pgrecordset_Ptr) return Boolean;
   -- Returns true if there was an error.

   function Error_Msg (Recordset : Pgrecordset_ptr) return String;
   -- Returns a string explaining the error.

   procedure error_Msg (Recordset : Pgrecordset_Ptr; Msg : out
String);
   -- Sets Msg with the error string;

   procedure query (Recordset : in out Pgrecordset_Ptr; Query :
String);
   -- Sends the query to de database and returns the resulting table;

   procedure Exec (Recordset : in out Pgrecordset_Ptr; Cmd : String);
   -- Sends the command to the database but returns no result.


   function Getcolnums (Rs: Pgrecordset_Ptr) return Integer;
   -- Returns number of columns in query table.

   function Getcolname (Rs: Pgrecordset_Ptr; Num: integer) return
String;
   -- Returns the column name.

   function GetData (Rs: Pgrecordset_Ptr; Column : String) return
String;
   -- Returns data in the named column in actual register.

private

   type Pgrecordset;
   type Pgrecordset_Ptr is access all pgRecordset;

   procedure check_errors (conx : in out pgrecordset_ptr);
end PGRecordset;
---------------------

Data Binding....
-------------------

with Gnu.Db.Sqlcli;
use Gnu.Db.Sqlcli;
with Gnu.Db.Sqlcli.Bind;

with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;

package Data_Bind is

   type Data_List is tagged private;
   type Base_Data is private;
   procedure DataFix (Elem : access Data_List);
   procedure Binddata (Data : access Data_List; Stmt : Sqlhstmt);

   type String_Data is private;
   type String_Data_Ptr is private;
   procedure DataFix (Elem : access String_Data);
   procedure Binddata (Data : access String_Data; Stmt : Sqlhstmt);

   -- This limits string data lenght to 256!!!!!
   subtype sql_str is String(1..256);
   type sql_str_access is access all sql_str;


   function Name2col (Stmt   : Sqlhstmt; Column : Unbounded_String )
return Sql_Column_Number;



--   procedure DataListFix ( List : access Data_List'Class);
   procedure DataListFix ( List : Base_Data);

   procedure RegisterData (List : in out Base_Data; Data :
String_access; Column : String);
   
   procedure UnRegisterData (List : in out Base_Data; Column :
String);
   
   procedure UnRegisterAll (List : in out Base_Data);

   procedure Binddatalist (List : Base_Data; Stmt : Sqlhstmt);

private

   type Base_Data is access all Data_List'Class;
   type Data_List is tagged
      record
         Field : Unbounded_String;
         Next  : Base_Data;
      end record;



   package String_Binding is new Gnu.Db.Sqlcli.Bind (Sql_Str,
                                                     Sql_Str_Access);
   package Sb renames String_Binding;

   type String_Data is new Data_List with
      record
         Data        : String_access;
         Data_Length : aliased Sqlinteger;
         Binded : Sql_Str_Access;
      end record;
   type String_Data_Ptr is access all String_Data;



end Data_Bind;
-------------------------
Extending this data_bind package should let you bind another data
types.
I tried to make this a pgrecordset's child package but i didnt find
the way...

The next one is an example using the this package. Sorry for the
variable names in spanish... ;)
----------------

with Pgrecordset;
with Data_Bind;
with text_io;

procedure Lista4 is
   package Db renames Pgrecordset;


   Conx : Db.Pgrecordset_Ptr;

   nombre : aliased String(1..30);
   Direc : aliased String (1..40);
   Edad : aliased String(1..5);

   Edad2 : Integer;
begin

   Conx := Db.Recordset_New("gestion");

   db.registerdata (Conx, nombre'Unrestricted_access, "name");
   db.registerdata (Conx, direc'Unrestricted_access, "address");
   db.registerdata (Conx, edad'Unrestricted_access, "age");
   db.query (conx, "select * from customers");
   db.movefirst(conx);

   declare
      fin : boolean := false;
   begin
      loop
         text_io.put_line ("Nombre : " & nombre);
         text_io.put_line ("Direc : " & direc);
         text_io.put_line ("edad : " & edad);
         db.movenext(conx);
         exit when Fin;
      end loop;
   exception
      when db.no_data => fin := true;
      when others => text_io.put_line ("Exception no tratada.");
   end;

--   Edad2 := integer'value(Edad) + 10;
--   Db.Exec (Conx, "insert into customers values
('"&Nombre&"','"&direc&"','"&Integer'Image(Edad2)&"')");


   declare begin
      Db.Recordset_Close (Conx);
      exception when others => Text_Io.Put_Line ("!!!!!!!");
      end;

end Lista4;
----------------
Hope this is usefull. I could send it to anybody...

Bye.