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

Comparing ibx/branches/journaling/fbintf/client/FBAttachment.pas (file contents):
Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC vs.
Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC

# Line 39 | Line 39 | interface
39  
40   uses
41    Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock,
42 <  FBActivityMonitor, FBClientAPI;
42 >  FBActivityMonitor, FBClientAPI, IBUtils;
43  
44   const
45    DefaultMaxInlineBlobLimit = 8192;
# Line 53 | Line 53 | type
53      AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
54    end;
55  
56 +  { Database Journalling.
57 +
58 +    This class is intended to support a client side journal of all database
59 +    updates, inserts and deletes made by the client during a session. It also records
60 +    the transaction each update was made under.
61 +
62 +    The database schema is required to include a control table "IBX$JOURNALS" and
63 +    an SQL Sequence IBX$SESSIONS. These are created by the class when the
64 +    database is opened, if they are not already present. However, it is recommended
65 +    that they are created as an orginal part of the database schema in order to
66 +    unnecessarily avoid each user being given sufficient priviledge to create tables
67 +    and Sequences.
68 +
69 +    Syntax:
70 +
71 +    Transaction Start:
72 +    *S:<date/time>,<session id>,<transaction no.>,<string length>:<transaction Name>,<string length>:<TPB>,<default Completion>
73 +
74 +    Transaction Commit:
75 +    *C:<date/time>,<session id>,<transaction no.>
76 +
77 +    Transaction Commit retaining :
78 +    *c:<date/time>,<session id>,<transaction no.><old transaction no.>
79 +
80 +    Transaction Rollback:
81 +    *R:<date/time>,<session id>,<transaction no.>
82 +
83 +    Transaction Rollback retaining:
84 +    *r:<date/time>,<session id>,<transaction no.><old transaction no.>
85 +
86 +    Update/Insert/Delete
87 +    *Q:<date/time>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
88 +
89 +  }
90 +
91 +  { TFBJournaling }
92 +
93 +  TFBJournaling = class(TActivityHandler, IJournallingHook)
94 +  private
95 +    {Logfile}
96 +    const sQueryJournal          = '*Q:''%s'',%d,%d,%d:%s' + LineEnding;
97 +    const sTransStartJnl         = '*S:''%s'',%d,%d,%d:%s,%d:%s,%d' + LineEnding;
98 +    const sTransCommitJnl        = '*C:''%s'',%d,%d' + LineEnding;
99 +    const sTransCommitRetJnl     = '*c:''%s'',%d,%d,%d' + LineEnding;
100 +    const sTransRollBackJnl      = '*R:''%s'',%d,%d' + LineEnding;
101 +    const sTransRollBackRetJnl   = '*r:''%s'',%d,%d,%d' + LineEnding;
102 +  private
103 +    FOptions: TJournalOptions;
104 +    FJournalFilePath: string;
105 +    FJournalFileStream: TStream;
106 +    FSessionID: integer;
107 +    FDoNotJournal: boolean;
108 +    function GetDateTimeFmt: AnsiString;
109 +  protected
110 +    procedure EndSession(RetainJournal: boolean);
111 +    function GetAttachment: IAttachment; virtual; abstract;
112 +  public
113 +    {IAttachment}
114 +    procedure Disconnect(Force: boolean=false); virtual;
115 +  public
116 +    {IJournallingHook}
117 +    procedure TransactionStart(Tr: ITransaction);
118 +    function TransactionEnd( TransactionID: integer; Action: TTransactionAction): boolean;
119 +    procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer;
120 +      Action: TTransactionAction);
121 +    procedure ExecQuery(Stmt: IStatement);
122 +  public
123 +    {Client side Journaling}
124 +    function JournalingActive: boolean;
125 +    function GetJournalOptions: TJournalOptions;
126 +    function StartJournaling(aJournalLogFile: AnsiString): integer; overload;
127 +    function StartJournaling(aJournalLogFile: AnsiString; Options: TJournalOptions): integer; overload;
128 +    procedure StopJournaling(RetainJournal: boolean);
129 +  end;
130 +
131    { TFBAttachment }
132  
133 <  TFBAttachment = class(TActivityHandler)
133 >  TFBAttachment = class(TFBJournaling)
134    private
135      FDPB: IDPB;
136      FFirebirdAPI: IFirebirdAPI;
# Line 90 | Line 165 | type
165      function getDPB: IDPB;
166      function AllocateBPB: IBPB;
167      function AllocateDIRB: IDIRB;
168 <    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
169 <    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
170 <    procedure Disconnect(Force: boolean=false); virtual; abstract;
168 >    function StartTransaction(TPB: array of byte;
169 >      DefaultCompletion: TTransactionCompletion;
170 >      aName: AnsiString=''): ITransaction; overload; virtual; abstract;
171 >    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion;
172 >      aName: AnsiString=''): ITransaction; overload; virtual; abstract;
173      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
174      procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
175      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
# Line 156 | Line 233 | type
233      function GetDBInformation(Requests: array of byte): IDBInformation; overload;
234      function GetDBInformation(Request: byte): IDBInformation; overload;
235      function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
236 +    function GetAttachmentID: integer;
237      function GetConnectString: AnsiString;
238      function GetRemoteProtocol: AnsiString;
239      function GetAuthenticationMethod: AnsiString;
# Line 166 | Line 244 | type
244      function GetInlineBlobLimit: integer;
245      procedure SetInlineBlobLimit(limit: integer);
246      function HasBatchMode: boolean; virtual;
247 +    function HasTable(aTableName: AnsiString): boolean;
248  
249    public
250      {Character Sets}
# Line 214 | Line 293 | type
293  
294   implementation
295  
296 < uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
296 > uses FBMessages, IBErrorCodes, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
297 >
298 > const
299 >  {Journaling}
300 >  sJournalTableName = 'IBX$JOURNALS';
301 >  sSequenceName = 'IBX$SESSIONS';
302 >
303 >  sqlCreateJournalTable =
304 >    'Create Table ' + sJournalTableName + '(' +
305 >    '  IBX$SessionID Integer not null, '+
306 >    '  IBX$TransactionID Integer not null, '+
307 >    '  IBX$OldTransactionID Integer, '+
308 >    '  IBX$USER VarChar(32) Default CURRENT_USER, '+
309 >    '  IBX$CREATED TIMESTAMP Default CURRENT_TIMESTAMP, '+
310 >    '  Primary Key(IBX$SessionID,IBX$TransactionID)' +
311 >    ')';
312 >
313 >  sqlCreateSequence = 'CREATE SEQUENCE ' + sSequenceName;
314 >
315 >  sqlGetNextSessionID = 'Select Gen_ID(' + sSequenceName + ',1) as SessionID From RDB$DATABASE';
316 >
317 >  sqlRecordJournalEntry = 'Insert into ' + sJournalTableName + '(IBX$SessionID,IBX$TransactionID,IBX$OldTransactionID) '+
318 >                        'Values(?,?,?)';
319 >
320 >  sqlCleanUpSession = 'Delete From ' + sJournalTableName + ' Where IBX$SessionID = ?';
321  
322   const
323    CharSetMap: array [0..69] of TCharsetMap = (
# Line 391 | Line 494 | const
494      'decfloat_traps'
495      );
496  
497 + type
498 +
499 +  { TQueryProcessor }
500 +
501 +  TQueryProcessor=class(TSQLTokeniser)
502 +  private
503 +    FInString: AnsiString;
504 +    FIndex: integer;
505 +    FStmt: IStatement;
506 +    function DoExecute: AnsiString;
507 +    function GetParamValue(ParamIndex: integer): AnsiString;
508 +  protected
509 +    function GetChar: AnsiChar; override;
510 +  public
511 +    class function Execute(Stmt: IStatement): AnsiString;
512 +  end;
513 +
514 +  { TQueryProcessor }
515 +
516 + function TQueryProcessor.DoExecute: AnsiString;
517 + var token: TSQLTokens;
518 +    ParamIndex: integer;
519 + begin
520 +  Result := '';
521 +  ParamIndex := 0;
522 +
523 +  while not EOF do
524 +  begin
525 +    token := GetNextToken;
526 +    case token of
527 +    sqltPlaceHolder:
528 +      begin
529 +        Result := Result + GetParamValue(ParamIndex);
530 +        Inc(ParamIndex);
531 +      end;
532 +    else
533 +      Result := Result + TokenText;
534 +    end;
535 +  end;
536 + end;
537 +
538 + function TQueryProcessor.GetParamValue(ParamIndex: integer): AnsiString;
539 + begin
540 +  with FStmt.SQLParams[ParamIndex] do
541 +  begin
542 +    if IsNull then
543 +      Result := 'NULL'
544 +    else
545 +    case GetSQLType of
546 +    SQL_BLOB:
547 +      if getSubType = 1 then {string}
548 +        Result := '''' + SQLSafeString(GetAsString) + ''''
549 +      else
550 +        Result := TSQLXMLReader.FormatBlob(GetAsString,getSubType);
551 +
552 +    SQL_ARRAY:
553 +        Result := TSQLXMLReader.FormatArray(getAsArray);
554 +
555 +    SQL_VARYING,
556 +    SQL_TEXT,
557 +    SQL_TIMESTAMP,
558 +    SQL_TYPE_DATE,
559 +    SQL_TYPE_TIME,
560 +    SQL_TIMESTAMP_TZ_EX,
561 +    SQL_TIME_TZ_EX,
562 +    SQL_TIMESTAMP_TZ,
563 +    SQL_TIME_TZ:
564 +      Result := '''' + SQLSafeString(GetAsString) + '''';
565 +    else
566 +      Result := GetAsString;
567 +    end;
568 +  end;
569 + end;
570 +
571 + function TQueryProcessor.GetChar: AnsiChar;
572 + begin
573 +  if FIndex <= Length(FInString) then
574 +  begin
575 +    Result := FInString[FIndex];
576 +    Inc(FIndex);
577 +  end
578 +  else
579 +    Result := #0;
580 + end;
581 +
582 + class function TQueryProcessor.Execute(Stmt: IStatement): AnsiString;
583 + begin
584 +  if not Stmt.IsPrepared then
585 +    IBError(ibxeSQLClosed,[]);
586 +  with self.Create do
587 +  try
588 +    FStmt := Stmt;
589 +    FInString := Stmt.GetProcessedSQLText;
590 +    FIndex := 1;
591 +    Result := Trim(DoExecute);
592 +  finally
593 +    Free;
594 +  end;
595 + end;
596 +
597 + { TFBJournaling }
598 +
599 + function TFBJournaling.GetDateTimeFmt: AnsiString;
600 + begin
601 +  {$IF declared(DefaultFormatSettings)}
602 +  with DefaultFormatSettings do
603 +  {$ELSE}
604 +  {$IF declared(FormatSettings)}
605 +  with FormatSettings do
606 +  {$IFEND}
607 +  {$IFEND}
608 +  Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzzz'
609 + end;
610 +
611 + procedure TFBJournaling.EndSession(RetainJournal: boolean);
612 + begin
613 +  if JournalingActive then
614 +  begin
615 +    FreeAndNil(FJournalFileStream);
616 +    if not RetainJournal then
617 +    try
618 +        GetAttachment.ExecuteSQL([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],
619 +             sqlCleanUpSession,[FSessionID]);
620 +        sysutils.DeleteFile(FJournalFilePath);
621 +    except On E: EIBInterBaseError do
622 +      if E.IBErrorCode <> isc_lost_db_connection then
623 +        raise;
624 +      {ignore - do not delete journal if database gone away}
625 +    end;
626 +    FSessionID := -1;
627 +  end;
628 + end;
629 +
630 + procedure TFBJournaling.Disconnect(Force: boolean);
631 + begin
632 +  if JournalingActive then
633 +    EndSession(Force);
634 + end;
635 +
636 + procedure TFBJournaling.TransactionStart(Tr: ITransaction);
637 + var LogEntry: AnsiString;
638 +    TPBText: AnsiString;
639 + begin
640 +  FDoNotJournal := true;
641 +  try
642 +    GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,NULL]);
643 +  finally
644 +    FDoNotJournal := false;
645 +  end;
646 +  TPBText := Tr.getTPB.AsText;
647 +  LogEntry := Format(sTransStartJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
648 +                                     FSessionID,
649 +                                     Tr.GetTransactionID,
650 +                                     Length(Tr.TransactionName),
651 +                                     Tr.TransactionName,
652 +                                     Length(TPBText),TPBText,
653 +                                     ord(tr.GetDefaultCompletion)]);
654 +  if assigned(FJournalFileStream) then
655 +    FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
656 + end;
657 +
658 + function TFBJournaling.TransactionEnd(TransactionID: integer;
659 +  Action: TTransactionAction): boolean;
660 +
661 + var LogEntry: AnsiString;
662 + begin
663 +  Result := false;
664 +    case Action of
665 +    TARollback:
666 +      begin
667 +        LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),FSessionID,TransactionID]);
668 +        Result := true;
669 +      end;
670 +    TACommit:
671 +      begin
672 +        LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),FSessionID,TransactionID]);
673 +        Result := true;
674 +      end;
675 +    end;
676 +    if assigned(FJournalFileStream) then
677 +      FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
678 + end;
679 +
680 + procedure TFBJournaling.TransactionRetained(Tr: ITransaction;
681 +  OldTransactionID: integer; Action: TTransactionAction);
682 + var LogEntry: AnsiString;
683 + begin
684 +    case Action of
685 +      TACommitRetaining:
686 +          LogEntry := Format(sTransCommitRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
687 +                                  FSessionID,Tr.GetTransactionID,OldTransactionID]);
688 +      TARollbackRetaining:
689 +          LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
690 +                                      FSessionID,Tr.GetTransactionID,OldTransactionID]);
691 +    end;
692 +    if assigned(FJournalFileStream) then
693 +      FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
694 +
695 +    FDoNotJournal := true;
696 +    try
697 +      GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,OldTransactionID]);
698 +    finally
699 +      FDoNotJournal := false;
700 +   end;
701 + end;
702 +
703 + procedure TFBJournaling.ExecQuery(Stmt: IStatement);
704 + var SQL: AnsiString;
705 +    LogEntry: AnsiString;
706 + begin
707 +  SQL := TQueryProcessor.Execute(Stmt);
708 +  LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
709 +                                      FSessionID,
710 +                                      Stmt.GetTransaction.GetTransactionID,
711 +                                      Length(SQL),SQL]);
712 +  if assigned(FJournalFileStream) then
713 +    FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
714 + end;
715 +
716 + function TFBJournaling.JournalingActive: boolean;
717 + begin
718 +  Result := (FJournalFileStream <> nil) and not FDoNotJournal;
719 + end;
720 +
721 + function TFBJournaling.GetJournalOptions: TJournalOptions;
722 + begin
723 +  Result := FOptions;
724 + end;
725 +
726 + function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString): integer;
727 + begin
728 +  Result := StartJournaling(aJournalLogFile,[joReadWriteTransactions,joModifyQueries]);
729 + end;
730 +
731 + function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString;
732 +  Options: TJournalOptions): integer;
733 + begin
734 +  FOptions := Options;
735 +  with GetAttachment do
736 +  begin
737 +    if not HasTable(sJournalTableName) then
738 +    begin
739 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateJournalTable);
740 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateSequence);
741 +    end;
742 +    FSessionID := OpenCursorAtStart(sqlGetNextSessionID)[0].AsInteger;
743 +  end;
744 +  FJournalFilePath := aJournalLogFile;
745 +  FJournalFileStream := TFileStream.Create(FJournalFilePath,fmCreate);
746 +  Result := FSessionID;
747 + end;
748 +
749 + procedure TFBJournaling.StopJournaling(RetainJournal: boolean);
750 + begin
751 +  EndSession(RetainJournal);
752 + end;
753 +
754 +
755  
756  
757   { TFBAttachment }
# Line 889 | Line 1250 | begin
1250      Result := GetDBInfo(getBuffer,getDataLength);
1251   end;
1252  
1253 + function TFBAttachment.GetAttachmentID: integer;
1254 + var Info: IDBInformation;
1255 + begin
1256 +  Info := GetDBInformation(isc_info_attachment_id);
1257 +  if (Info.Count > 0) and (Info[0].getItemType = isc_info_attachment_id) then
1258 +    Result := Info[0].getAsInteger
1259 +  else
1260 +    Result := -1;
1261 + end;
1262 +
1263   function TFBAttachment.GetConnectString: AnsiString;
1264   begin
1265    Result := FDatabaseName;
# Line 942 | Line 1313 | begin
1313    Result := false;
1314   end;
1315  
1316 + function TFBAttachment.HasTable(aTableName: AnsiString): boolean;
1317 + begin
1318 +  Result := OpenCursorAtStart(
1319 +       'Select count(*) From RDB$RELATIONS Where RDB$RELATION_NAME = ?',
1320 +          [aTableName])[0].AsInteger > 0;
1321 + end;
1322 +
1323   function TFBAttachment.HasDefaultCharSet: boolean;
1324   begin
1325    Result := FHasDefaultCharSet

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines