Replicate.dbl

;*****************************************************************************
;
; File:         Replicate.dbl
;
; Description:  Adds new instructions to the replication servers instruction file.
;
; Author:       Steve Ives, Synergex Professional Services Group
;
;*****************************************************************************
;
; Copyright (c) 2009, Synergex International, Inc.
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are met:
;
; * Redistributions of source code must retain the above copyright notice,
;   this list of conditions and the following disclaimer.
;
; * Redistributions in binary form must reproduce the above copyright notice,
;   this list of conditions and the following disclaimer in the documentation
;   and/or other materials provided with the distribution.
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.
;
;*****************************************************************************

import ReplicationLibrary

.include "REPLICATION_INSTRUCTION" repository, enum, end

subroutine Replicate

    required in aInstanceName,  string
    required in aAction,        REPLICATION_INSTRUCTION
    optional in aTableName,     a
    optional in aRecord,        a

.ifdef D_VMS
    .include "REPLICATION_VMS" repository, stack record="instruction", end
.else
    .include "REPLICATION" repository, stack record="instruction", end
.endc

    static record
        instances, @StringDictionary
    endrecord

    stack record
        instanceName, string
        instanceObj,  @object
        instanceData, @InstanceInfo
    endrecord

proc
    instanceName = aInstanceName

    ;-----------------------------------------------------------------------------------------------------------------------
    ; Make sure we have the queue file open for the current instance

    ;;Do we need to create the StringDictionary?
    if (instances == ^null)
    begin
        instances = new StringDictionary()
    end

    ;Are we already tracking this instance?
    if (instances.TryGet(instanceName,instanceObj)) then
    begin
        ;Yes, record the additional channel associated with the instance.
        instanceData = (@InstanceInfo)instanceObj
        instanceData.ReferenceCount += 1
    end
    else
    begin
        ;Not currently tracking this instance
        data instanceQueueFile, string, "REPLICATOR_DATA:REPLICATION_" + instanceName + ".ISM"
        data instanceChannel, int
        data errorMessage, string

        ;Open the instance queue file
        if (!%OpenOrCreateQueueFile(instanceQueueFile,instanceChannel,errorMessage))
        begin
            throw new ApplicationException("Failed to open or create replication queue file " + instanceQueueFile + ". Error was " + errorMessage)
        end

        ;Create and track the instance data
        instanceData = new InstanceInfo() { QueueFile=instanceQueueFile, Channel=instanceChannel, ReferenceCount=1 }
        instances.Add(instanceName,instanceData)
    end

    ;;-----------------------------------------------------------------------------------------------------------------------

    using aAction select

    (REPLICATION_INSTRUCTION.OPEN_FILE),
    begin
        ;Here we used to have the code that is now above, to open and track the instance queue file,
        ;but there are some scenarios (in replicator menu for example) where other instructions can
        ;be written BEFORE the OPEN_FILE operation (e.g. STOP commands).
    end

    (REPLICATION_INSTRUCTION.CLOSE_FILE),
    begin
        ;Get the instance data
        instanceData = (@InstanceInfo)(instances.Get(instanceName))
        ;Record one less channel associated with the instance.
        instanceData.ReferenceCount -= 1
        ;If there are no more channels associated with the instance, remove the instance data.
        if (instanceData.ReferenceCount == 0)
        begin
            ;Close the instances queue file
            if (instanceData.Channel && %chopen(instanceData.Channel))
            begin
                close instanceData.Channel
                instanceData.Channel = 0
            end
            instances.Remove(instanceName)
            instanceData = ^null
        end

        ;If we are no longer tracking any instances, remove the StringDictionary
        if (instances.Items().Length == 0)
        begin
            instances = ^null
        end
    end

    (REPLICATION_INSTRUCTION.DELETE_FIRST_INSTRUCTION),
    begin
        ;Get the instance data
        instanceData = (@InstanceInfo)(instances.Get(instanceName))

        ;Delete first pending instruction only
        try
        begin
            read(instanceData.Channel,instruction,^FIRST)
            delete(instanceData.Channel)
        end
        catch (ex, @EndOfFileException)
        begin
            nop
        end
        catch (ex, @Exception)
        begin
            sleep 0.0001
        end
        endtry
    end

    (REPLICATION_INSTRUCTION.DELETE_ALL_INSTRUCTIONS),
    begin
        ;Get the instance data
        instanceData = (@InstanceInfo)(instances.Get(instanceName))

        ;Delete pending instructions
        try 
        begin
            data sts, d1
            close instanceData.Channel
            ;This seems really strange, but it is a work-around for a bug in ISCLR in All
            ;versions prior to 10.3.3e that would cause any subsequent OPEN(CHN=0 to fail
            ;following a failed XCALL ISCLR until a successful XCALL ISCLR had taken place.
            ;The workaround is to open the file for exclusive access, and if that fails,
            ;don't try to do the XCALL ISCLR
            open(instanceData.Channel=0,"U:I",instanceData.QueueFile,SHARE:Q_EXCL_RW)
            close instanceData.Channel
            xcall isclr(instanceData.QueueFile,sts)
            open(instanceData.Channel=0,"U:I",instanceData.QueueFile)
        end
        catch (ex, @FileInUseException)
        begin
            open(instanceData.Channel=0,"U:I",instanceData.QueueFile)
            repeat
            begin
                try
                begin
                    read(instanceData.Channel,instruction,^FIRST)
                    delete(instanceData.Channel)
                end
                catch (ex1, @EndOfFileException)
                begin
                    exitloop
                end
                catch (ex1, @Exception)
                begin
                    sleep 0.01
                end
                endtry
            end
        end
        endtry
    end

    (),
    begin
        ;Get the instance data
        instanceData = (@InstanceInfo)(instances.Get(instanceName))

        ;Configure the new instruction

        init instruction

        instruction.action = (i)aAction

        if (^passed(aTableName) && aTableName)
        begin
            instruction.structure_name = aTableName
        end

        if (^passed(aRecord) && aRecord)
        begin
            instruction.record = aRecord
        end

        ;And add it to the queue

.ifdef OS_VMS
        ;On VMS we don't have auto sequence keys so we need to allocate a %DATETIME value as the
        ;transaction ID and be prepared to retry if we get a duplicate key error.
        instruction.transaction_id = %datetime
        repeat
        begin
            store(instanceData.Channel,instruction) [$ERR_NODUPS=dupkey]
            if (false)
            begin
dupkey,         instruction.transaction_id = ^a(^d(instruction.transaction_id)+1)
                nextloop
            end
            exitloop
        end
.else
        ;On other platforms we can just store the transaction
        store(instanceData.Channel,instruction)
.endc

    end
    endusing

    xreturn

endsubroutine