NAT3145: Find out real name of the user who holds a record

First of all: Sorry for posting the code inside the Text. But It’s not possible for me to attach a File with the extension NSN…

At our company, the ADABAS databases and the NATURAL Runtime Environment is hosted on the same computer. So it’s possible to find out the real name of the user who holds a record by using the programs I attached to this post.

But I’m sure there’s still a lot to improve. For example:

  • Is it possible to do the whole thing without using so many workfiles and “CALL ‘SHCMD’”?
  • What about remote databases? We can get no information about them, because they’re connected to our Natural via EntireX…

Kind regards,

Matthias

*
* Find out real name of user, who holds a record
*************************************************
*
* Usage:
*
**   In the program, which does the login:
**    --> write information into a Userlogfile
*
*   COMPRESS 'echo PID' *PID 'User' *USER '>>/tmp/user.log' into #cmd
*   CALL 'SHCMD' #cmd
*
**   In every dialog-program
*
*   ON ERROR
*     IF *ERROR-NR = 3145
*       CALLNAT 'ADAHLD-N' #ISN #RETURNCODE #USER_ID
*       DECIDE ON FIRST VALUE OF #RETURNCODE
*         VALUE 0
*           input 'Record is held by' #USER_ID (AD=O) /
*             'Press ENTER to RETRY'
*           RETRY
*         VALUE 1 : 5
*           input 'Record is held by some other user' /
*             'Press ENTER to RETRY'
*           RETRY
*         NONE VALUE
*           write 'Internal error calling ADAHLD-N' #RETURNCODE
*       END-DECIDE
*     END-IF
*   END-ERROR
*
* Input-Parameter:
*     1. ISN           /* UDB and FileNo are detected automatically
*
* Output-Parameter
*     2. RETURNCODE
*         0 = sucessfully terminated
*         1 = Error during detecting File-No. (USR2010N)
*         2 = Error during calling USR1040N
*         3 = Error during calling OS-command 'adaopr ... di=hq'
*         4 = Error during detecting PID
*         5 = real USER name not knwon
*             (maybe record is locked by a batch user)
*       > 5 = NATURAL-Runtime error (*ERROR-NR)
*
*     3. USER_ID
*
***********************************************************************
*
define data parameter
*
01 #input-parameter
  02 ISN          (P10) BY VALUE
01 #output-parameter
  02 RETURNCODE   (I04) BY VALUE RESULT
  02 USER_ID      (A08) BY VALUE RESULT
*
local
*
01 #options
  02 workfile-folder (A) DYNAMIC const <'/tmp/'>   /* with slash at end!
  02 user-logfile    (A) DYNAMIC const <'/tmp/user.log'>
*
01 #usr2010  (A16)
01 redefine #usr2010
  02 DB_STATUS      (A1)   /* Status code
  02 DB_TYPE        (A1)   /* DB type
  02 DB_DBID        (B2)   /* Databas ID
  02 DB_FNR         (B2)   /* File number
  02 DB_COMMAND     (A2)   /* Database Command
  02 DB_RESP        (B2)   /* Response Code
  02 DB_SUBCODE     (B2)   /* Response subcode
  02 DB_ADD1F2B     (B2)   /* first 2 bytes off additions1 field
*
01 #FILE_A   (A) DYNAMIC
01 #ISN_A    (A) DYNAMIC
01 #FILE_I   (I4)
01 #DBID_I   (I4)
01 #ESID_I   (I4)
01 #line-tab (A/1:7) DYNAMIC
*
01 #WORKFILE (A) DYNAMIC
01 #LINE     (A80)         /* WORKFILE-Line. Listing: "adaopr di=hq"
01 redefine #line
  02 FILLER    37X
  02 ESID    (A05)
  02 FILLER    03X
  02 ETID    (A08)
*
01 #USR1040
  02 DBID         (N05)
  02 RESPONSE     (I04)
*
01 #command        (A)  DYNAMIC
*
end-define
*
ON ERROR
  MOVE *ERROR-NR to #output-parameter.RETURNCODE
  escape module
END-ERROR
*
*
reset #output-parameter
*
* get last DB call error
*
callnat 'USR2010N' #USR2010
*
#DBID_I := #usr2010.DB_DBID
#FILE_I := #usr2010.DB_FNR
*
IF #FILE_I = 0
  #output-parameter.RETURNCODE := 1
  escape module
END-IF
*
IF #DBID_I = 0
  callnat 'USR1040N' 'G' #USR1040
  if #usr1040.response ne 0
    #output-parameter.RETURNCODE := 2
    escape module
  end-if
  #DBID_I := #usr1040.DBID
END-IF
*
* call OS-command ADAOPR and redirect output into a workfile
*
MOVE EDITED #input-parameter.ISN (EM=-Z,ZZZ,ZZZ,ZZ9) to #ISN_A
*
MOVE EDITED #FILE_I             (EM=ZZZZ9) to #FILE_A
*
* create an unique name for temporary workfile
compress #options.workfile-folder
   *PROGRAM '_' #DBID_I '_' *PID '.txt'
  into #workfile leaving no
*
* no adaopr-parameter FILE/ISN, because ISN has a maximum of 65535 then
*
compress 'adaopr db=' #DBID_I " di=hq | tail +12 | grep '^.\{54\}"
  #FILE_A #ISN_A "$' >" #workfile " 2>/dev/null"
  into #command leaving no
*
call 'shcmd' #command
if ret('shcmd') ne 0
  #output-parameter.RETURNCODE := 3
  perform delete-workfile
  escape module
end-if
*
* read WORKFILE and delete it
*
define work file 1 #workfile
read work 1 once #line
close work file 1
perform delete-workfile
*
#ESID_I := val(#line.ESID)
*
* read userlog-file
*
if #line.ESID = ' '
  #output-parameter.RETURNCODE := 4
  escape module
end-if
*
define work file 2 #options.user-logfile
read work 2 #line
  separate #line into #line-tab(*) with delimiters H'20'
  reject if #line-tab(1) ne 'PID'
  reject if #line-tab(3) ne 'User'
  reject if val(#line-tab(2)) ne #ESID_I
  #output-parameter.USER_ID := #line-tab(4)
end-work
close work file 2
*
if #output-parameter.USER_ID = ' '
  #output-parameter.RETURNCODE := 5
  escape module
end-if
*
*
define subroutine delete-workfile
*
if *LENGTH(#workfile) > 0
  compress 'rm -f ''' #workfile '''' into #command leaving no
  call 'shcmd' #command
end-if
*
end-subroutine

end

For Adabas 5 you have to edit the following code snippets:

01 #LINE     (A80)         /* WORKFILE-Line. Listing: "adaopr di=hq"
01 redefine #line
*   02 FILLER    37X     /* Adabas 3
*   02 ESID    (A05)
*   02 FILLER    03X
*   02 ETID    (A08)
  02 FILLER    34X     /* Adabas 5
  02 ESID    (A05)
  02 FILLER    01X
  02 ETID    (A08)

* adabas 3
* compress 'adaopr db=' #NATERR1a.UDB " di=hq | tail +12 | grep '^.\{54\}" /* adabas 3
*   #FILE_A #ISN_A "$' >" #workfile " 2>/dev/null"
*
* adabas 5
compress numeric 'adaopr db=' #NATERR1a.UDB
  ' file=' #NATERR1a.FILE_NO ' isn='  #input-parameter.ISN
  " di=hq | tail +12 >" #workfile " 2>/dev/null"
  into #command leaving no