Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/DBL Pascal Library/TransactionMgr/Transactions

Text File | 1993-04-14 | 9.8 KB | 292 lines | [TEXT/PJMM]

unit Transactions;

{The Transactions unit provides a framework for combining groups of operations on related}
{data into a single transaction. The transaction may be committed, cancelled, undone and}
{redone using a standard interface to a user-supplied routine that implements the semantics}
{of these transaction operations in terms of the user data and operations.}
{}
{This unit does not impose a particular semantics on transactions — semantics are the domain}
{of a user-supplied action routine. This framework can support both "update-on-commit" and}
{"retract-on-cancel" semantics. Update-on-commit semantics implies that any data created}
{during a transaction is not committed to the “live” database until the transaction is committed.}
{Retract-on-cancel means that the “live” database is modified during the transaction, and}
{restored to its pre-transaction state if the transaction is cancelled. You may also implement}
{a mixed strategy. For example, you could use "retract-on-cancel" for added and changed}
{records, but "update-on-commit" for deletions.}

interface

    type
        TransactionHandle = Handle;
        TransactionOp = (    {}
            transactionOpCommit,        {}
            transactionOpCancel,        {}
            transactionOpUndo,            {}
            transactionOpRedo,            {}
            transactionOpDispose        {}
            );

{NewTransaction creates a new transaction record. The record is valid until DisposeTransaction.}
{The transaction record may be reused for multiple transactions; it is initialized by each call to}
{BeginTransaction.}
    function NewTransaction: TransactionHandle;

{BeginTransaction initializes the given transaction record for a new transaction, and records}
{the user’s actionProc which will be called to process entries on behalf of EndTransaction,}
{UndoTransaction, and RedoTransaction. The user’s actionProc is declared as follows:}
{    procedure ActionProc (userData, userAction: Longint; operation: TransactionOp; cancelled, undone: Boolean);    }
    procedure BeginTransaction (transaction: TransactionHandle;
                                    actionProc: ProcPtr);

{RecordTransactionStep remembers one step of the current transaction. A step is represented}
{by a datum and an action. Any memory needed to store information about the step must be}
{allocated by the caller, and disposed by the user action proc when called with the dispose op.}
    function RecordTransactionStep (transaction: TransactionHandle;
                                    transData, actionCode: univ Longint): OSErr;

{TransactionExists searches the transaction record and returns true if a matched transaction is}
{found. Match criteria is established by a user supplied function. The match function must not}
{have side effects on the transaction, userData or userAction. The search begins with the most}
{recent transaction step if fromEnd is true.}
    function TransactionExists (transaction: TransactionHandle;
                                    fromEnd: Boolean;
                                    function MatchFunc (userData, userAction: Longint): Boolean): Boolean;

{EndTransaction marks the end of all steps which comprise the current transaction. The}
{transaction may be committed or not — the action proc is called with the appropriate op code.}
{The action proc is called on step data in the same order as recorded for a commit, and in the}
{reverse order for a cancel. A cancelled transaction becomes non-undoable, even if it was}
{specified as undoable.}
    procedure EndTransaction (transaction: TransactionHandle;
                                    commit: Boolean);

{TransactionCancelled returns true if the transaction was cancelled (not committed).}
    function TransactionCancelled (transaction: TransactionHandle): Boolean;

{SetTransactionUndoable specifies whether a transaction is undoable. Newly-created}
{transactions are not undoable. The state may be changed at any time.}
    procedure SetTransactionUndoable (transaction: TransactionHandle;
                                    undoable: Boolean);

{TransactionUndoable returns true if the transaction is undoable (or redoable).}
{The result is the same even if the transaction has been undone.}
    function TransactionUndoable (transaction: TransactionHandle): Boolean;

{If the transaction is undoable, and has not previously been undone, UndoTransaction calls the}
{action proc using the undo op code with the step information in forward order.}
    procedure UndoTransaction (transaction: TransactionHandle);

{TransactionUndone returns True if the transaction has been undone.}
    function TransactionUndone (transaction: TransactionHandle): Boolean;

{If the transaction is undoable, and has been undone, RedoTransaction calls the}
{action proc using the redo op code with the step information in reverse order.}
    procedure RedoTransaction (transaction: TransactionHandle);

{DisposeTransaction calls the action proc using the dispose op code with the step information}
{in forward order, then disposes of the transaction record and sets it to nil.}
    procedure DisposeTransaction (var transaction: TransactionHandle);

implementation

    type
        TransactionEntry = record
                userData: Longint;
                userAction: Longint;
            end;
        TransactionRecHeader = record
                userProc: ProcPtr;
                count: Integer;
                canUndo, undone, cancelled: Boolean;
            end;
        TransactionRec = record
                header: TransactionRecHeader;
                entries: array[1..1] of TransactionEntry;
            end;
        TransactionRecPtr = ^TransactionRec;
        TransactionRecHdl = ^TransactionRecPtr;

    function NewTransaction: TransactionHandle;
    begin
        NewTransaction := NewHandleClear(SIZEOF(TransactionRecHeader));
    end;

    procedure BeginTransaction (transaction: TransactionHandle;
                                    actionProc: ProcPtr);
    begin
        with TransactionRecHdl(transaction)^^.header do
            begin
                userProc := actionProc;
                count := 0;
                canUndo := False;
                undone := False;
                cancelled := False;
            end;
        SetHandleSize(Handle(transaction), SIZEOF(TransactionRecHeader));
    end;

    procedure CallActionProc (userData, userAction: Longint;
                                    operation: TransactionOp;
                                    cancelled, undone: Boolean;
                                    actionProc: ProcPtr);
    inline
        $205F,    {    move.l (a7)+,a0}
        $4E90;    {    jsr (a0)}

    type
        OpDirection = (firstToLast, lastToFirst);

    procedure ProcessTransactionOp (transaction: TransactionHandle;
                                    operation: TransactionOp;
                                    direction: OpDirection);
        var
            i: Integer;
    begin
        HLock(transaction);
        with TransactionRecHdl(transaction)^^, header do
            if direction = lastToFirst then
                for i := count downto 1 do
{$PUSH}
{$R-}
                    with entries[i] do
{$POP}
                        CallActionProc(userData, userAction, operation, cancelled, undone, userProc)
            else
                for i := 1 to count do
{$PUSH}
{$R-}
                    with entries[i] do
{$POP}
                        CallActionProc(userData, userAction, operation, cancelled, undone, userProc);
        HUnlock(transaction);
    end;

    function TransactionExists (transaction: TransactionHandle;
                                    fromEnd: Boolean;
                                    function MatchFunc (userData, userAction: Longint): Boolean): Boolean;
        var
            i: Integer;
            result: Boolean;
    begin
        result := False;
        HLock(Handle(transaction));
        with TransactionRecHdl(transaction)^^, header do
            if fromEnd then
                begin
                    for i := count downto 1 do
{$PUSH}
{$R-}
                        with entries[i] do
{$POP}
                            if MatchFunc(userData, userAction) then
                                begin
                                    result := True;
                                    Leave;
                                end;
                end
            else
                begin
                    for i := 1 to count do
{$PUSH}
{$R-}
                        with entries[i] do
{$POP}
                            if MatchFunc(userData, userAction) then
                                begin
                                    result := True;
                                    Leave;
                                end;
                end;
        HUnlock(Handle(transaction));
        TransactionExists := result;
    end;

    procedure EndTransaction (transaction: TransactionHandle;
                                    commit: Boolean);
    begin
        if commit then
            ProcessTransactionOp(transaction, transactionOpCommit, firstToLast)
        else
            begin
                ProcessTransactionOp(transaction, transactionOpCancel, lastToFirst);
                SetTransactionUndoable(transaction, False);
                TransactionRecHdl(transaction)^^.header.cancelled := True;
            end;
    end;

    function TransactionCancelled (transaction: TransactionHandle): Boolean;
    begin
        TransactionCancelled := TransactionRecHdl(transaction)^^.header.cancelled;
    end;

    procedure SetTransactionUndoable (transaction: TransactionHandle;
                                    undoable: Boolean);
    begin
        with TransactionRecHdl(transaction)^^.header do
            if not cancelled then
                canUndo := undoable;
    end;

    function TransactionUndoable (transaction: TransactionHandle): Boolean;
    begin
        TransactionUndoable := TransactionRecHdl(transaction)^^.header.canUndo;
    end;

    procedure UndoTransaction (transaction: TransactionHandle);
    begin
        with TransactionRecHdl(transaction)^^.header do
            if canUndo and not undone then
                begin
                    ProcessTransactionOp(transaction, transactionOpUndo, lastToFirst);
                    TransactionRecHdl(transaction)^^.header.undone := True;
                end;
    end;

    function TransactionUndone (transaction: TransactionHandle): Boolean;
    begin
        TransactionUndone := TransactionRecHdl(transaction)^^.header.undone;
    end;

    procedure RedoTransaction (transaction: TransactionHandle);
    begin
        with TransactionRecHdl(transaction)^^.header do
            if canUndo and undone then
                begin
                    ProcessTransactionOp(transaction, transactionOpRedo, firstToLast);
                    TransactionRecHdl(transaction)^^.header.undone := False;
                end;
    end;

    procedure DisposeTransaction (var transaction: TransactionHandle);
    begin
        ProcessTransactionOp(transaction, transactionOpDispose, lastToFirst);
        DisposeHandle(Handle(transaction));
        transaction := nil;
    end;

    function RecordTransactionStep (transaction: TransactionHandle;
                                    transData, actionCode: univ Longint): OSErr;
    begin
        SetHandleSize(Handle(transaction), GetHandleSize(Handle(transaction)) + SIZEOF(TransactionEntry));
        if MemError <> noErr then
            begin
                RecordTransactionStep := MemError;
                Exit(RecordTransactionStep);
            end
        else
            with TransactionRecHdl(transaction)^^, header do
                if userProc <> nil then
                    begin
                        count := count + 1;
{$PUSH}
{$R-}
                        with entries[count] do
{$POP}
                            begin
                                userData := transData;
                                userAction := actionCode;
                            end;
                    end;
    end;

end.