ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBEvents.pas
(Generate patch)

Comparing:
ibx/trunk/fbintf/client/FBEvents.pas (file contents), Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
ibx/branches/udr/client/FBEvents.pas (file contents), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

# Line 60 | Line 60
60   {                                                                        }
61   {************************************************************************}
62   unit FBEvents;
63 + {$IFDEF MSWINDOWS}
64 + {$DEFINE WINDOWS}
65 + {$ENDIF}
66  
67   {$IFDEF FPC}
68 < {$mode objfpc}{$H+}
68 > {$mode delphi}
69   {$interfaces COM}
70   {$ENDIF}
71  
# Line 75 | Line 78 | type
78  
79    { TFBEvents }
80  
81 +  {Firebird Event and Result buffer syntax is:
82 +
83 +    record
84 +      version: byte;
85 +      event: array of packed record
86 +        strlen: byte;
87 +        strchars: array of AnsiChar; //no of chars given by strlen
88 +        EventCounts: long;
89 +      end;
90 +    end;
91 +
92 +  }
93 +
94    TFBEvents = class(TActivityReporter)
95    private
96      FEvents: TStringList;
97      FAttachment: IAttachment;
98 +    FEventCounts: TEventCounts;
99 +    FFirebirdClientAPI: TFBClientAPI;
100    protected
101 <    FEventBuffer: PChar;
101 >    FEventBuffer: PByte;
102      FEventBufferLen: integer;
103 <    FResultBuffer: PChar;
103 >    FResultBuffer: PByte;
104      FEventHandler: TEventHandler;
105      FCriticalSection: TCriticalSection;
106      FInWaitState: boolean;
# Line 90 | Line 108 | type
108      procedure CancelEvents(Force: boolean = false); virtual;
109      procedure EventSignaled;
110      function GetIEvents: IEvents; virtual; abstract;
111 +    procedure ProcessEventCounts;
112 +  public
113 +    const EPB_version1 = 1;
114    public
115      constructor Create(DBAttachment: IAttachment; aMonitor: IActivityMonitor; Events: TStrings);
116      destructor Destroy; override;
# Line 97 | Line 118 | type
118      {IEvents}
119      procedure GetEvents(EventNames: TStrings);
120      procedure SetEvents(EventNames: TStrings); overload;
121 <    procedure SetEvents(Event: string); overload;
121 >    procedure SetEvents(Event: AnsiString); overload;
122      procedure Cancel;
123      function ExtractEventCounts: TEventCounts;
124      function GetAttachment: IAttachment;
125 +    procedure AsyncWaitForEvent(EventHandler: TEventHandler); virtual; abstract;
126    end;
127  
128  
# Line 113 | Line 135 | const
135  
136   { TFBEvents }
137  
138 + (* Original Firebird 'C' code
139 +
140 + SLONG API_ROUTINE_VARARG isc_event_block(UCHAR** event_buffer,
141 +  UCHAR** result_buffer,
142 +  USHORT count, ...)
143 + {
144 + /**************************************
145 + *
146 + *      i s c _ e v e n t _ b l o c k
147 + *
148 + **************************************
149 + *
150 + * Functional description
151 + *      Create an initialized event parameter block from a
152 + *      variable number of input arguments.
153 + *      Return the size of the block.
154 + *
155 + *      Return 0 if any error occurs.
156 + *
157 + **************************************/
158 +        va_list ptr;
159 +
160 +        va_start(ptr, count);
161 +
162 +        // calculate length of event parameter block, setting initial length to include version
163 +        // and counts for each argument
164 +
165 +        SLONG length = 1;
166 +        USHORT i = count;
167 +        while (i--)
168 +        {
169 +                const char* q = va_arg(ptr, SCHAR * );
170 +                length += static_cast<SLONG>(strlen(q)) + 5;
171 +        }
172 +        va_end(ptr);
173 +
174 +        UCHAR* p = *event_buffer = (UCHAR * ) gds__alloc((SLONG) length);
175 +        // FREE: apparently never freed
176 +        if (!*event_buffer)                     // NOMEM:
177 +                return 0;
178 +        if ((*result_buffer = (UCHAR * ) gds__alloc((SLONG) length)) == NULL)
179 +        {
180 +                // NOMEM:
181 +                // FREE: apparently never freed
182 +                gds__free(*event_buffer);
183 +                *event_buffer = NULL;
184 +                return 0;
185 +        }
186 +
187 +        // initialize the block with event names and counts
188 +
189 +        *p++ = EPB_version1;
190 +
191 +        va_start(ptr, count);
192 +
193 +        i = count;
194 +        while (i--)
195 +        {
196 +                const char* q = va_arg(ptr, SCHAR * );
197 +
198 +                // Strip the blanks from the ends
199 +                const char* end = q + strlen(q);
200 +                while (--end >= q && *end == ' ')
201 +                        ;
202 +                *p++ = end - q + 1;
203 +                while (q <= end)
204 +                        *p++ = *q++;
205 +                *p++ = 0;
206 +                *p++ = 0;
207 +                *p++ = 0;
208 +                *p++ = 0;
209 +        }
210 +        va_end(ptr);
211 +
212 +        return static_cast<SLONG>(p - *event_buffer);
213 + }
214 + *)
215 +
216 + {CreateEventBlock effectively replaces isc_event_block}
217 +
218   procedure TFBEvents.CreateEventBlock;
219 < var
220 <  i: integer;
119 <  EventNames: array of PChar;
219 > var i: integer;
220 >    P: PByte;
221   begin
222 <  with FirebirdClientAPI do
222 >  {calculate length of event parameter block, setting initial length to include version
223 >   and counts for each argument}
224 >
225 >  FEventBufferLen := 1;
226 >  for i := 0 to FEvents.Count - 1 do
227 >    FEventBufferLen := FEventBufferLen + length(FEvents[i]) + 1 + sizeof(Long);
228 >
229 >  with FFirebirdClientAPI do
230    begin
231 <    if FEventBuffer <> nil then
232 <      isc_free( FEventBuffer);
233 <    FEventBuffer := nil;
234 <    if FResultBuffer <> nil then
235 <      isc_free( FResultBuffer);
236 <    FResultBuffer := nil;
231 >    IBAlloc(FEventBuffer,0,FEventBufferLen);
232 >    if FEventBuffer = nil then Exit;
233 >    FillChar(FEventBuffer^,FEventBufferLen,0);
234 >    IBAlloc(FResultBuffer,0,FEventBufferLen);
235 >    if FResultBuffer = nil then
236 >    begin
237 >      FreeMem(FEventBuffer);
238 >      Exit;
239 >    end;
240 >    FillChar(FResultBuffer^,FEventBufferLen,0);
241 >
242 >    P := FEventBuffer;
243 >    P^ := EPB_version1;
244 >    Inc(P);
245 >    SetLength(FEventCounts,FEvents.Count);
246  
247 <    setlength(EventNames,MaxEvents);
248 <    try
249 <      for i := 0 to FEvents.Count-1 do
250 <        EventNames[i] := PChar(FEvents[i]);
251 <
252 <      FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
253 <                          FEvents.Count,
137 <                          EventNames[0],EventNames[1],EventNames[2],
138 <                          EventNames[3],EventNames[4],EventNames[5],
139 <                          EventNames[6],EventNames[7],EventNames[8],
140 <                          EventNames[9],EventNames[10],EventNames[11],
141 <                          EventNames[12],EventNames[13],EventNames[14]
142 <                          );
143 <    finally
144 <      SetLength(EventNames,0)
247 >    for i := 0 to FEvents.Count - 1 do
248 >    begin
249 >      P^ := Length(FEvents[i]);
250 >      Inc(P);
251 >      Move(FEvents[i][1],P^,Length(FEvents[i]));
252 >      Inc(P,Length(FEvents[i])+sizeof(Long));
253 >      FEventCounts[i].EventName := FEvents[i];
254      end;
255    end;
256 +
257 + {  for i := 0 to FEventBufferLen - 1 do
258 +  write(Format('%x ', [FEventBuffer[i]]));
259 +   writeln;}
260   end;
261  
262   procedure TFBEvents.CancelEvents(Force: boolean);
# Line 154 | Line 267 | end;
267   procedure TFBEvents.EventSignaled;
268   var Handler: TEventHandler;
269   begin
270 +  Handler := nil;
271    FCriticalSection.Enter;
272    try
273      if not FInWaitState then Exit;
274      FInWaitState := false;
275 +    ProcessEventCounts;
276      if assigned(FEventHandler)  then
277      begin
278        Handler := FEventHandler;
279        FEventHandler := nil;
280      end;
281    finally
282 <    FCriticalSection.Leave
282 >    FCriticalSection.Leave;
283 >  end;
284 >  if assigned(Handler) then
285 >    Handler(GetIEvents);
286 > end;
287 >
288 > (*
289 >  Original Firebird 'C' code for isc_event_counts
290 >
291 > void API_ROUTINE isc_event_counts(ULONG* result_vector,
292 >                                                                  SSHORT buffer_length,
293 >                                                                  UCHAR* event_buffer,
294 >                                                                  const UCHAR* result_buffer)
295 > {
296 > /**************************************
297 > *
298 > *      g d s _ $ e v e n t _ c o u n t s
299 > *
300 > **************************************
301 > *
302 > * Functional description
303 > *      Get the delta between two events in an event
304 > *      parameter block.  Used to update gds_events
305 > *      for GPRE support of events.
306 > *
307 > **************************************/
308 >        ULONG* vec = result_vector;
309 >        const UCHAR* p = event_buffer;
310 >        const UCHAR* q = result_buffer;
311 >        USHORT length = buffer_length;
312 >        const UCHAR* const end = p + length;
313 >
314 >        // analyze the event blocks, getting the delta for each event
315 >
316 >        p++;
317 >        q++;
318 >        while (p < end)
319 >        {
320 >                // skip over the event name
321 >
322 >                const USHORT i = (USHORT)* p++;
323 >                p += i;
324 >                q += i + 1;
325 >
326 >                // get the change in count
327 >
328 >                const ULONG initial_count = gds__vax_integer(p, sizeof(SLONG));
329 >                p += sizeof(SLONG);
330 >                const ULONG new_count = gds__vax_integer(q, sizeof(SLONG));
331 >                q += sizeof(SLONG);
332 >                *vec++ = new_count - initial_count;
333 >        }
334 >
335 >        // copy over the result to the initial block to prepare
336 >        // for the next call to gds__event_wait
337 >
338 >        memcpy(event_buffer, result_buffer, length);
339 > }
340 > *)
341 >
342 > {ProcessEventCounts effectively replaces isc_event_counts}
343 >
344 > procedure TFBEvents.ProcessEventCounts;
345 >
346 > var i: integer;
347 >    P, Q: PByte;
348 >    initial_count: Long;
349 >    new_count: Long;
350 >    len: byte;
351 > begin
352 >  P := FEventBuffer;
353 >  Q := FResultBuffer;
354 >  Inc(P); {skip past version byte}
355 >  Inc(Q);
356 >  for i := 0 to Length(FEventCounts) - 1 do
357 >  with FFirebirdClientAPI do
358 >  begin
359 >    {skip over the event name}
360 >    len := P^;
361 >    P := P + len + 1;
362 >    Q := Q + len + 1; {event name length in P^}
363 >    initial_count := DecodeInteger(P,sizeof(Long));
364 >    Inc(P,sizeof(Long));
365 >    new_count := DecodeInteger(Q,sizeof(Long));
366 >    Inc(Q,sizeof(Long));
367 >    FEventCounts[i].Count := new_count - initial_count;
368    end;
369 <  Handler(GetIEvents);
369 >  Move(FResultBuffer^,FEventBuffer^,FEventBufferLen);
370   end;
371  
372   constructor TFBEvents.Create(DBAttachment: IAttachment;
# Line 174 | Line 374 | constructor TFBEvents.Create(DBAttachmen
374   begin
375    inherited Create(aMonitor);
376    FAttachment := DBAttachment;
377 +  FFirebirdClientAPI := DBAttachment.getFirebirdAPI as TFBClientAPI;
378    if Events.Count > MaxEvents then
379      IBError(ibxeMaximumEvents, [nil]);
380  
# Line 187 | Line 388 | destructor TFBEvents.Destroy;
388   begin
389    if assigned(FCriticalSection) then FCriticalSection.Free;
390    if assigned(FEvents) then FEvents.Free;
391 <  with FirebirdClientAPI do
391 >  with FFirebirdClientAPI do
392    begin
393      if FEventBuffer <> nil then
394 <      isc_free( FEventBuffer);
394 >      FreeMem( FEventBuffer);
395      if FResultBuffer <> nil then
396 <      isc_free( FResultBuffer);
396 >      FreeMem( FResultBuffer);
397    end;
398    inherited Destroy;
399   end;
# Line 203 | Line 404 | begin
404   end;
405  
406   procedure TFBEvents.SetEvents(EventNames: TStrings);
407 + var i: integer;
408   begin
409 +  {$ifdef Unix}
410 +  if (EventNames.Count > 0) and not IsMultiThread then
411 +    IBError(ibxeMultiThreadRequired,['Firebird Events Handling']);
412 +  {$endif}
413    if EventNames.Text <> FEvents.Text then
414    begin
415      Cancel;
416 <    FEvents.Assign(EventNames);
416 >    for i := 0 to EventNames.Count - 1 do
417 >      FEvents[i] := Trim(EventNames[i]);
418      CreateEventBlock;
419    end;
420   end;
421  
422 < procedure TFBEvents.SetEvents(Event: string);
422 > procedure TFBEvents.SetEvents(Event: AnsiString);
423   var S: TStringList;
424   begin
425    S := TStringList.Create;
# Line 231 | Line 438 | begin
438   end;
439  
440   function TFBEvents.ExtractEventCounts: TEventCounts;
234 var EventCountList, P: PISC_LONG;
235    i: integer;
236    j: integer;
441   begin
442 <  SetLength(Result,0);
239 <  if FResultBuffer = nil then Exit;
240 <
241 <  GetMem(EventCountList,sizeof(ISC_LONG)*FEvents.Count);
242 <  try
243 <    with FirebirdClientAPI do
244 <       isc_event_counts( EventCountList, FEventBufferLen, FEventBuffer, FResultBuffer);
245 <    j := 0;
246 <    P := EventCountList;
247 <    for i := 0 to FEvents.Count - 1 do
248 <    begin
249 <      if EventCountList[i] > 0 then
250 <      begin
251 <        Inc(j);
252 <        SetLength(Result,j);
253 <        Result[j-1].EventName := FEvents[i];
254 <        Result[j-1].Count := P^;
255 <        Inc(P);
256 <      end;
257 <    end;
258 <  finally
259 <    FreeMem(EventCountList);
260 <  end;
442 >  Result := FEventCounts;
443   end;
444  
445   function TFBEvents.GetAttachment: IAttachment;

Comparing:
ibx/trunk/fbintf/client/FBEvents.pas (property svn:eol-style), Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
ibx/branches/udr/client/FBEvents.pas (property svn:eol-style), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines