From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,72b10ed43fd78730 X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2002-01-06 13:12:33 PST Path: archiver1.google.com!news1.google.com!newsfeed.stanford.edu!news-spur1.maxwell.syr.edu!news.maxwell.syr.edu!unlisys!news.snafu.de!not-for-mail From: Michael Erdmann Newsgroups: comp.lang.ada Subject: Re: Call for review: Database API for the GNADE Project Date: Sun, 06 Jan 2002 22:14:25 +0100 Organization: http://purl.org/NET/michael.erdmann Message-ID: <3C38BE31.D4F6B495@snafu.de> References: <3C2E334F.EF4C534@snafu.de> NNTP-Posting-Host: tc09-n66-227.de.inter.net Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Mailer: Mozilla 4.75 [de] (X11; U; Linux 2.2.16-22 i686) X-Accept-Language: en CC: Julio Cano Xref: archiver1.google.com comp.lang.ada:18591 Date: 2002-01-06T22:14:25+01:00 List-Id: Since the GNADE projects objective is to be also a repository for different approaches to Ada 95 data base interfaces for Ada 95 it is very usefull. Please could you send me a copy, or even better if you like we can present it on the project pages if you are willing to support the code in the future as a member of the GNADE team? Michael Julio Cano schrieb: > 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.