demo/simple_demo.adb

   1 with Ada.Text_IO; use Ada.Text_IO;
   2 with Backlit.Postgres; use Backlit.Postgres;
   3
   4 procedure Simple_Demo is
   5
   6    use Backlit;
   7
   8    D,D1,D2 : DBD_Type;
   9
  10    procedure Create_Film_Table
  11      (D : in out DBD_Type)
  12    is
  13       R : Result_Type;
  14    begin
  15       Put_Line ("Create_Film_Table");
  16       --declare
  17       --   D : DBD_Type;
  18       begin
  19          --  the command can be split in more than one line, in fact
  20          --  the command will be executed as a single command.
  21          --  check the documentation for more info.
  22          D.Append_Command ("DROP TABLE films;");
  23          D.Exec (R);
  24       exception
  25          when Backlit.Query_Error =>
  26             Put_Line (Error_Message (R));
  27       end;
  28       D.Append_Command ("CREATE TABLE films (");
  29       D.Append_Command (" code        char(5) CONSTRAINT firstkey PRIMARY KEY,");
  30       D.Append_Command (" title       varchar(40) NOT NULL,");
  31       D.Append_Command (" did         integer NOT NULL,");
  32       D.Append_Command (" date_prod   date,");
  33       D.Append_Command (" kind        varchar(10),");
  34       D.Append_Command (" len         interval hour to minute);");
  35       D.Exec (R);
  36       Put ("Create_Film_Table :");
  37       if R.Status = COMMAND_OK then
  38          Put_Line ("Ok");
  39       else
  40          Put_Line ("Failed");
  41       end if;
  42    exception
  43       when Backlit.Query_Error =>
  44          Put_Line (Error_Message (R));
  45    end Create_Film_Table;
  46
  47    procedure Insert_Value_1 (D : in out DBD_Type)
  48    is
  49       R : Result_Type;
  50    begin
  51       D.Append_Command ("INSERT INTO films");
  52       D.Append_Command ("(code, title, did,date_prod, kind, len)");
  53       D.Append_Command ("VALUES (1, 'test1', 1, '12-24-2008', 'test', '1h35m');");
  54       D.Exec (R);
  55     exception
  56       when Backlit.Query_Error =>
  57          Put_Line (Error_Message (R));
  58    end Insert_Value_1;
  59
  60    procedure Prepare_1 (D : in out DBD_Type)
  61    is
  62    begin
  63       Put_Line ("prepare_procedure :");
  64       D.Append_Command ("INSERT INTO films");
  65       D.Append_Command ("(code, title, did,date_prod, kind, len)");
  66       D.Append_Command ("VALUES ($1, $2, $3, $4, $5, $6);");
  67       D.Prepare ("films_insert", 6);
  68    end Prepare_1;
  69
  70    procedure Insert_Prepared_1
  71      (D : in out DBD_Type)
  72    is
  73       R : Result_Type;
  74       Count : Natural := 0;
  75    begin
  76       for I in 1 .. 9 loop
  77          Count := Count + 1;
  78          Put_Line ("=> code :" & Count'Img);
  79          D.Bind_Parameter (6, "2h45m");
  80          D.Bind_Parameter (4, "01-30-2007");
  81          D.Bind_Parameter (2, "test" & Count'Img);
  82          D.Bind_Parameter (3, Count'img);
  83          D.Bind_Parameter (5, "test" & Count'Img);
  84          D.Bind_Parameter (1, Count'Img);
  85          --  The bind parameter can be put in any order
  86          --  thanks to Ada.Containers.Indefinite_Ordered_Maps.
  87          D.Exec (R,"films_insert");
  88          -- we insert an error here :
  89          if Count = 8 then
  90             Put_Line ("=> We insert an error here : duplicate key");
  91             Count := 7;
  92          end if;
  93       end loop;
  94    exception
  95       when Backlit.Query_Error =>
  96          Put_Line (Error_Message (R));
  97    end Insert_Prepared_1;
  98
  99    procedure Insert_Value_2 (D : in out DBD_Type)
 100    is
 101       R : Result_Type;
 102       Code : Natural := 20;
 103    begin
 104       Put_Line ("=> We insert directly some value with code 20 named test 20");
 105       D.Append_Command ("INSERT INTO films");
 106       D.Append_Command ("(code, title, did,date_prod, kind, len)");
 107       D.Append_Command ("VALUES ($1, $2, $3, $4, $5, $6);");
 108       D.Bind_Parameter (6, "2h45m");
 109       D.Bind_Parameter (4, "01-30-2007");
 110       D.Bind_Parameter (2, "test 20");
 111       D.Bind_Parameter (3, "3");
 112       D.Bind_Parameter (5, "test 20");
 113       D.Bind_Parameter (1, Code'Img);
 114       --  The bind parameter can be put in any order
 115       --  thanks to Ada.Containers.Indefinite_Ordered_Maps.
 116       D.Exec (R);
 117     exception
 118       when Backlit.Query_Error =>
 119          Put_Line (Error_Message (R));
 120    end Insert_Value_2;
 121
 122    procedure select_1 (D : in out DBD_Type)
 123    is
 124       R  : Result_Type;
 125       NT : Tuples_Type;
 126       NF : Fields_Type;
 127    begin
 128       D.Append_Command ("SELECT code, title FROM films");
 129       D.Append_Command ("WHERE did=$1 OR date_prod > $2;");
 130       D.Bind_Parameter (1, "1");
 131       D.Bind_Parameter (2, "01-30-2000");
 132       D.Exec (R);
 133       if R.Status = TUPLES_OK then
 134          NT := R.N_Tuples;
 135          Put_Line ("number of tuples :" & NT'Img);
 136          NF := R.N_Fields;
 137          Put_Line ("number of fields :"& NF'Img);
 138       end if;
 139       for I in First_Tuples (R) .. Last_Tuples (R) loop
 140          Put ('|');
 141          for J in First_Fields (R) .. Last_Fields (R) loop
 142             Put (R.Get_Value (I, J));
 143             Put ('|');
 144             if J = NF - 1 then
 145                New_Line;
 146             end if;
 147          end loop;
 148       end loop;
 149
 150    exception
 151       when Backlit.Query_Error =>
 152          Put_Line (Error_Message (R));
 153    end Select_1;
 154
 155
 156 begin
 157    ---------------------------
 158    --  Database Connection  --
 159    ---------------------------
 160    ----  there is two way to set the connection
 161    ----  but you can't use both on the same connection.
 162
 163    --  D.Set_Host_Name ("localhost");
 164    --  D.Set_Host_Address ("127.0.0.1");
 165    --  D.Set_User_Name ("postgres");
 166    --  D.Set_db_Name ("template1");
 167    --  D.Set_User_Password ("secret");
 168    --  D.Set_Port ("5432");
 169    ----  and then make a server connection
 170    --  D.Connect;
 171
 172    --  The other way is to pass the connection parameter
 173    --  as a string at the connection time
 174    Put_Line ("stating connection...");
 175    D.Connect ("host=localhost user=postgres dbname=template1");
 176
 177    -------------------------
 178    --  command execution  --
 179    -------------------------
 180    if Is_Connected (D) then
 181       Put ("Connected!");
 182    else
 183       Put ("connection failure!");
 184    end if;
 185    New_Line;
 186    --  you may create your own connection procedure
 187    --  giving the user different try for the password
 188    --  for example.
 189    --  check the Needs_Password and Used_Password functions.
 190
 191    Create_Film_Table (D);
 192    --  Insert_Value_1 (D);
 193    D1 := D;
 194    D1.Connect;
 195    Prepare_1 (D1);
 196    Insert_Prepared_1 (D1);
 197    D2 := D1;
 198    D2.Connect;
 199    Insert_Value_2 (D2);
 200    Select_1 (D);
 201    New_Line;
 202
 203 exception
 204    when Backlit.Error =>
 205       Put_Line (Error_Message (D));
 206 end Simple_Demo;