[fpc-pascal] DBus interface needs an update

[Luca Olivetti]

En/na Jonathan ha escrit:
> On Mon, 18 May 2009 13:38:55 +0200
> Matthias Klumpp <matthias at nlinux.org> wrote:
> 
>> I've spent hours to get the Pascal DBus interface working for me, but even
>> the example code does not work.
> 
> I need to use DBus to but I can not make it work.
> Has anyone made DBus and HAL work with fpc?

About a year and a half ago I had DBus working, but I used it only to 
communicate between my apps (so I have both a server and a client part).
Sorry, I cannot help too much, I just hope that whatever change is made 
it doesn't break backwards compatibility.

Below is the client part (the usage of the reply parameters is specific 
to my application, but the method should be general) inside a form.
ErrorDbus is a method that displays and logs the error message.

some private fields of the form:

     //Dbus
     err: DBusError;
     conn: PDBusConnection;

in formCreate:

    { Initializes the errors }
    dbus_error_init(@err);

    { Connection }
    conn := dbus_bus_get(DBUS_BUS_SYSTEM, @err);

    if dbus_error_is_set(@err) <> 0 then
    begin
      ErrorDbus('Connection Error: ' + err.message);
      dbus_error_free(@err);
    end;

cyclic bus call (called from a 200ms timer), note that I expect 14 
parameters in the reply.


procedure TEstadoForm.BusCall;
const MAXPARAM=14;
var
   msg: PDBusMessage;
   args: DBusMessageIter;
   pending: PDBusPendingCall;
   param: PChar;
   i:integer;
   numparams:integer;
   LocByte:byte;
   LocString:string;
   LocInteger:integer;
   NoMoreParams:boolean;

   procedure NextParam;
   begin
      if NoMoreParams then exit;
      numparams:=numparams+1;
      if dbus_message_iter_next(@args)=0 then
      begin
        if numparams<=MAXPARAM then ErrorDbus('Not enough parameters');
        NoMoreParams:=true;
      end;
   end;

   function GetStringParam:boolean;
   begin
     if NoMoreParams then
     begin
       result:=false;
       exit;
     end;
     result:=dbus_message_iter_get_arg_type(@args)=DBUS_TYPE_STRING;
     if not result then
     begin
       ErrorDbus(format('Parameter %d is not a string',[numparams]));
       exit;
     end;
     dbus_message_iter_get_basic(@args, @param);
     LocString:=strpas(param);
   end;

   function GetByteParam:boolean;
   var partype:cint;
   begin
     if NoMoreParams then
     begin
       result:=false;
       exit;
     end;
     partype:=dbus_message_iter_get_arg_type(@args);
     result:=partype=DBUS_TYPE_BYTE;
     if not result then
     begin
        //dirty trick: since the first response parameter should be
        //a byte, here I check if it is a string
        //in such case it is a dbus error message
        if (numparams=1) and (partype=DBUS_TYPE_STRING) then
        begin
          dbus_message_iter_get_basic(@args, @param);
          ErrorDbus(param);
          numparams:=MAXPARAM;
          exit;
        end;
        ErrorDbus(format('Parameter %d is not a byte',[numparams]));
        exit;
     end;
     dbus_message_iter_get_basic(@args, @LocByte);
   end;

   function GetIntegerParam:boolean;
   begin
     result:=false;
     if NoMoreParams then exit;
     if dbus_message_iter_get_arg_type(@args)<>DBUS_TYPE_INT32 then
     begin
       ErrorDbus(format('Parameter %d is not int32',[numparams]));
       exit;
     end;
     result:=true;
     dbus_message_iter_get_basic(@args, @LocInteger);
   end;

begin
   ErrorDbus('ok');
   // create a new method call and check for errors
   msg := dbus_message_new_method_call('es.wetron.almacen_tapas.server', 
// target for the method call
                                       '/almacen_tapas/method/Object', 
// object to call on
 
'es.wetron.almacen_tapas.method.Status', // interface to call on
                                       'GetStatus'); // method name
   if (msg = nil) then
   begin
     ErrorDbus('Message Null');
     Exit;
   end;

   // send message and get a handle for a reply
   if (dbus_connection_send_with_reply(conn, msg, @pending, -1) = 0) 
then // -1 is default timeout
   begin
     ErrorDbus('Out Of Memory!');
     Exit;
   end;
   if (pending = nil) then
   begin
     ErrorDbus('Pending Call Null');
     Exit;
   end;
   dbus_connection_flush(conn);

   //WriteLn('Request Sent');

   // free message
   dbus_message_unref(msg);

   // block until we recieve a reply
   dbus_pending_call_block(pending);

   // get the reply message
   msg := dbus_pending_call_steal_reply(pending);
   if (msg = nil) then
   begin
     ErrorDbus('Reply Null');
     Exit;
   end;
   // free the pending message handle
   dbus_pending_call_unref(pending);

   // read the parameters
   if dbus_message_iter_init(msg, @args)=0 then
   begin
      ErrorDbus('No parameters in reply')
   end else
   begin
     numparams:=1;
     NoMoreParams:=false;

     if GetByteParam then VisualizaBits(FEntradas,locbyte);
     NextParam;

     if GetByteParam then VisualizaBits(FSalidas, locbyte);
     NextParam;

     if GetStringParam then LabelEstadoLectura.caption:=LocString;
     NextParam;

     if GetStringParam then LabelEstadoSalida.caption:=LocString;
     NextParam;

     for i:=1 to 4 do
     begin
       if GetStringParam then PantallaDescarga[i].caption:=LocString;
       NextParam;
     end;

     if GetIntegerParam then 
DescargaBandejaPidiendo.caption:=IntToStr(LocInteger);
     NextParam;

     if GetIntegerParam then 
DescargaBandejaBoca.caption:=IntToStr(LocInteger);
     NextParam;

     if GetStringParam then LabelEstadoEntrada.caption:=LocString;
     NextParam;

     for i:=1 to 4 do
     begin
       if GetStringParam then PantallaCarga[i].caption:=LocString;
       NextParam;
     end;

     if GetIntegerParam then 
CargaBandejaPidiendo.caption:=IntToStr(LocInteger);
     NextParam;

     if GetIntegerParam then CargaBandejaBoca.caption:=IntToStr(LocInteger);
     NextParam;

     if GetStringParam then for i:=1 to 7 do 
DescargaGrid.Cells[i,1]:=ExtractWord(i,LocString,[',']);
     NextParam;

     if GetIntegerParam then if Initfifo or (LocInteger<>FifoSerial) 
then GetFifo(LocInteger);
   end;
   // free reply
   dbus_message_unref(msg);
end;

Bye

-- 
Luca