Cannot implement Wikipedia sample for handling database events in FreePascal/Lazarus

Question

For two weeks now I'm trying to implement a Firebird events handler to my 'daemon-like' program in FreePascal which has to work on Linux. I think I have tried everything, but I still cannot register any event sent by a database (which should be registered in a log)- daemon isn't crashing, it keeps loggings it's activity. Two GUIs I've created (Lazarus on Windows and Ubuntu) are working without any problem.

What am I doing wrong? Is it possible to make daemon program with event listener? Maybe those questions aren't the smartest but I'm absolutely out of ideas.

Program Daemon;

{$mode objfpc}{$H+}

uses
  {$DEFINE UseCThreads}
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  SysUtils, BaseUnix, sqldb, IBConnection, FBEventMonitor;

{ TMyEventAlert }                        {c}
type
  TMyEventAlert=class
class procedure OnFBEvent(Sender: TObject; EventName: string; EventCount: longint;
 var CancelAlerts: boolean);
end;

Var
   { vars for daemonizing }
   bHup,
   bTerm : boolean;
   textPolaczenia, textZdarzenia, config : text;
   SlogPolaczenia, SlogZdarzenia,  nazwaHosta, sciezkaBazaDanych, uzytkownik, haslo: string;

   aOld,
   aTerm,
   aHup : pSigActionRec;
   ps1  : psigset;
   sSet : cardinal;
   pid  : pid_t;
   secs : longint;

   zerosigs : sigset_t;
   EventAlert : TMyEventAlert;
   EventsM :TFBEventMonitor;
   //EventAlert: TMyEventAlert;
   BConnection : TIBConnection;
   SQLQuery1: TSQLQuery;
   SQLTransaction1: TSQLTransaction;


   { handle SIGHUP & SIGTERM }
   procedure DoSig(sig : longint);cdecl;
   begin
      case sig of
         SIGHUP : bHup := true;
         SIGTERM : bTerm := true;
      end;
   end;



class procedure TMyEventAlert.OnFBEvent(Sender: TObject; EventName: string;
   EventCount: longint; var CancelAlerts: boolean);
   begin
     //some basic do's
     SlogZdarzenia := 'SlogZdarzenia.log';
     AssignFile(textZdarzenia,SlogZdarzenia);
     Rewrite(textZdarzenia);
     Writeln(textZdarzenia,'Cos sie zdarzylo');
     CloseFile(textZdarzenia);
     end;


Procedure WpisPolaczenie;
Begin
   AssignFile(textPolaczenia,SLogPolaczenia);
   Append(textPolaczenia);
   Writeln(textPolaczenia,'Connected to database at ',formatdatetime('hh:nn:ss',now));
   CloseFile(textPolaczenia);
End;

procedure CreateConnection;

   begin
      BConnection := TIBConnection.Create(nil);


      BConnection.DataBaseName := '/home/pi/bazydanych/aaa';
      BConnection.Hostname := 'localhost';
      BConnection.UserName:='sysdba';
      BConnection.Password:='masterkey';


      EventsM:=TFBEventMonitor.create(nil);
      EventsM.Connection:=BConnection;
      EventsM.Events.Add('baba');
      EventsM.OnEventAlert:[email protected];
      EventsM.RegisterEvents;



Begin

   SlogPolaczenia := 'SlogPolaczenia.log';                        {setting up 'connection variables'}
   SlogZdarzenia:= 'SlogZdarzenia.log';
   secs := 15;


   fpsigemptyset(zerosigs);

   { set global daemon booleans }
      bHup := true; { to open log file }
      bTerm := false;

      { block all signals except -HUP & -TERM }
      sSet := $ffffbffe;
      ps1 := @sSet;
      fpsigprocmask(sig_block,ps1,nil);

      { setup the signal handlers }
      new(aOld);
      new(aHup);
      new(aTerm);
      aTerm^.sa_handler{.sh} := SigactionHandler(@DoSig);

      aTerm^.sa_mask := zerosigs;
      aTerm^.sa_flags := 0;
      {$ifndef BSD}                {Linux'ism}
       aTerm^.sa_restorer := nil;
      {$endif}
      aHup^.sa_handler := SigactionHandler(@DoSig);
      aHup^.sa_mask := zerosigs;
      aHup^.sa_flags := 0;
      {$ifndef BSD}                {Linux'ism}
       aHup^.sa_restorer := nil;
      {$endif}
      fpSigAction(SIGTERM,aTerm,aOld);
      fpSigAction(SIGHUP,aHup,aOld);

      { daemonize }
      pid := fpFork;
      Case pid of
         0 : Begin { we are in the child }
            Close(input);  { close standard in }
            Close(output); { close standard out }
            Assign(output,'/dev/null');
            ReWrite(output);
            Close(stderr); { close standard error }
            Assign(stderr,'/dev/null');
            ReWrite(stderr);
         End;
         -1 : secs := 0;     { forking error, so run as non-daemon }
         Else Halt;          { successful fork, so parent dies }
      End;

      { begin processing loop }
      Repeat
         If bHup Then Begin
            {$I-}
            Close(textPolaczenia);
            {$I+}
            IOResult;
         {$I+}
          //UtworzLogi;
         {fggggggd}

         bHup := false;
      End;
      {----------------------}
                                               {'program' part of a daemon}
      CreateConnection;



      {----------------------}
      If bTerm Then
         BREAK
      Else
         { wait a while }
         fpSelect(0,nil,nil,nil,secs*1000);
   Until bTerm;
   End.

Thank you Abelisto & Nested Type for your previous answers and help.

'Body' of a program is based on a free sample by CncWare, to check if is it working properly I use

tail -f SlogPolaczenie.log // activity log

tail -f SlogEvents.log // events log

ps ax | grep nameofaprogram

kill -TERM processIDListedafterPsAXGrepNameoOfAprogram

Answer 1

It looks like the OnFBEvent declaration is wrong. It has to be a method, not a global procedure:

procedure TSomething.OnFBEvent(Sender: TObject; EventName: string;EventCount: longint; var CancelAlerts: boolean); register;
begin
end; 

So you have to declare somewhere such a class and create an instance:

type TSomething = class
  procedure OnFBEvent(Sender: TObject; EventName: string;EventCount: longint; var CancelAlerts: boolean); register;
end;

If you look at the sample, OnFBEvent is a method of TForm1. So if you reproduce the example in a GUI program you can also declare the method in the main form. If you're in a console then it's like explained before.

Also note that if you're not in {$MODE DELPHI} the event must be assigned with an @,

EventsM.OnEventAlert:= @Someting.OnFBEvent;