*DECK DB$WR2J 
USETEXT CDCSCTX 
USETEXT JLPCMTX 
      PROC DB$WR2J; 
      BEGIN 
 #
* *   DB$WR2J - BEFORE-IMAGE LOGGING FOR WRITE   PAGE  1
* *   BOB MCALLESTER                             DATE  01/20/83 
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE DOES THE BEFORE-IMAGE LOGGING IF IT IS REQUIRED
*     FOR THE WRITE SYMBIONT. 
*     THIS INCLUDES THE READ TO BE SURE THAT THERE IS NOT AN EXISTING 
*     RECORD BEFORE RECORDING THE BEFORE-IMAGE. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     NONE
* 
* D   ASSUMPTIONS 
* 
*     P<TQT> IS SET.
*     P<FPT> IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL -
*       THE BEFORE-IMAGE HAS BEEN WRITTEN ON THE JOURNAL LOG. 
*     ABNORMAL -
*       IF A RECORD ALREADY EXISTS WITH THE GIVEN KEY,
*       DB$FTEX IS CALLED TO TERMINATE THE WRITE REQUEST. 
* 
* DC  CALLING ROUTINES
* 
*     DB$WR2$                WRITE CONTROL SYMBIONT 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FLOP;     # RECORD A FLOW POINT                     #
      XREF PROC DB$FSET;     # SELECT FIT FOR DB$WR2$                  #
      XREF PROC DB$FSIO;     # SET INTERNAL FIT                        #
      XREF PROC DB$FTEX;     # INTERNAL FIT ERROR EXIT                 #
      XREF PROC DB$JLH;      # INITIALIZE LOG RECORD HEADER            #
      XREF PROC DB$JLO;      # OUTPUT A JOURNAL LOG RECORD             #
      XREF ITEM DB$RA0;      # PARAMETER LIST TERMINATOR               #
      XREF PROC GET;         # CRM READ INTERFACE                      #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     COMMON BLOCK "DB$JLCM" VARIABLES DEFINED IN JLPCMTX.
*       P<PRIMKEY>
*       PARLEN
*       TRLRLEN 
*       P<JLREC>
*         JLHDWDA[0]
* 
*     P<IFT> IS SET BY DB$SIFT. 
* 
* DC  DESCRIPTION 
* 
*     ATTEMPT A READ ON THE RECORD KEY VALUE OF THE RECORD
*     THAT IS TO BE WRITTEN.
*     THIS READ SHOULD RETURN A CRM ERROR "445" (KEY NOT FOUND).
* 
*     IF THE "445" IS RETURNED WE PROCEED TO WRITE THE
*     "WRITE BEFORE-IMAGE" TO THE JOURNAL LOG FILE, OR TRANSACTION
*     FILE. 
* 
*     IF A RECORD IS READ SUCCESSFULLY, ERROR CODE "446" IS ENTERED 
*     INTO THE FIT AND DB$FTEX IS CALLED AS IF IT HAD BEEN CALLED 
*     FROM CRM ON A WRITE WITH DUPLICATE KEY. 
* 
*     THE ABOVE STEPS ARE NOT ATTEMPTED IF THE FILE IS
*     OPENED FOR OUTPUT.
* 
* 
*     THE BEFORE-IMAGE JOURNAL LOG RECORD IS THEN WRITTEN.
 #
  
# 
*     LOCAL VARIABLES 
# 
      BASED ARRAY FIT;;      # DUMMY USED FOR CRM CALLS                #
  
  
  
#     B E G I N   D B $ W R 2 J   E X E C U T A B L E   C O D E        #
  
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("WR2J");
      CONTROL ENDIF;
  
      IF FPFITPD[0] NQ 2     # IF THE FILE IS NOT OPENED FOR OUTPUT    #
      THEN
        BEGIN 
#       ATTEMPT TO READ THE RECORD.                                    #
#       IF THE READ IS SUCCESSFUL, ABORT THE WRITE REQUEST BEFORE      #
#       THE BEFORE-IMAGE LOG RECORD IS WRITTEN.                        #
  
        DB$FSIO;               # SET UP INTERNAL FIT                   #
        UFFITWSA[0] = TQSCWSA; # USE SCHEMA WORKING STORAGE AREA       #
        FPFTEX[0] = DFFTEX0;   # ZERO ERROR EXIT SO CONTROL IS RETURNED#
  
#       USE THE INTERNAL FIT (IFT) FOR THIS READ.                      #
#       THIS RETAINS FILE POSITION ON THE UFT FOR A SET OF SEQUENTIAL  #
#       READS BY ALTERNATE KEY THAT COULD BE IN PROGRESS.              #
  
#       THE SCHEMA BUFFER IS USED FOR THIS READ EVEN THOUGH IT CONTAINS#
#       THE RECORD THAT IS TO BE WRITTEN.                              #
#       IF THE READ TRANSFERS DATA TO THE BUFFER, THE WRITE IS ABORTED.#
  
        P<FIT> = LOC(UFFIT[0]); 
        GET(FIT,DB$RA0);
  
#       THE ERROR STATUS SHOULD BE "445" (KEY NOT FOUND).              #
#       IF NOT, CALL DB$FTEX TO PROCESS THE ERROR.                     #
  
        IF UFFITES[0] NQ O"445" 
        THEN
          BEGIN 
          IF UFFITES[0] EQ 0
          THEN                 # IF NO ERROR WAS RETURNED              #
            BEGIN              # USE "446" (DUPLICATE KEY)             #
            UFFITES[0] = O"446";
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("WR2J-DK"); 
            CONTROL ENDIF;
  
            END 
          FPFTEX[0] = DFFTEX1; # SO DB$FTEX WILL ACCEPT THE CALL       #
          DB$FTEX;
          END 
        UFFITES[0] = 0;        # RESTORE NORMAL UFT STATUS             #
        FPFTEX[0] = DFFTEX1;
        END 
  
#     PROCEED WITH THE BEFORE-IMAGE LOGGING.                           #
  
      PARLEN = DFHDRSZ + UFFITKL[0];
      DB$JLH;                # INITIALIZE JOURNAL LOG RECORD HEADER    #
  
      P<PRIMKEY> = UFFITKA[0];
      IF RSARLGBR[0]
      THEN
        JLHDWDA[0] = DFJLWDABW;    # IDENTIFIER FOR BEFORE/WRITE       #
      ELSE
        JLHDWDA[0] = DFJLWDATW;    # IDENTIFIER FOR TRANSACTION/WRITE  #
      TRLRLEN = 0;
      DB$JLO;                # OUTPUT A LOG RECORD                     #
  
      DB$FSET;               # SELECT THE FIT FOR DB$WR2$ TO USE       #
  
      END 
      TERM
