Could anyone please tell me how to find out the name of the current library a Natural module is in? I know the system variable *LIBRARY-ID but it does not work if the current module is in a steplib and is called from outside the steplib, e.g.:
LIB1.MOD1:
WRITE *LIBRARY-ID
CALLNAT 'MOD2' /* in steplib STEP1
For error handling you can use USR2001N, USR2006N or USR2026N.
But I don’t know a simple way to get the library of any module. Maybe a combination of USR2026N and USR0330N helps - but I confess that’s not a really good way…
unfortunately, that doesn’t work either. USR0330N returns a library but the problem stays the same: modules in a steplib return the library name of the calling module
Right now, I’m thinking about implementing the functionality myself… I could search the current library and all its steblibs (returned from a user exit) for the current module name (e.g. via the file system) and return the first match (that should be the correct one, since Natural searches the libraries in the same order, right?).
Stefan, I don’t know if this is any help, but we needed a function to return a module’s Type. In doing so we had to find the module’s library. Here’s the code.
* Function : S$OBJTYP(<ModuleName>)
*
* Action : Returns the last character of the extension of compiled objects
*
* NB! Depends on SYSEXT modules USR0330N, USR3025N
*
* Returns : .NSx (A1)
*
* Parameters : ModuleName (A8) Must be UPPER CASE
*
* Author : Anthony Rose
* Date : 2009
**********************************************************************************************
DEFINE FUNCTION S$OBJTYP RETURNS (A1) /* MODULE.NSx<-
DEFINE DATA
PARAMETER
1 #MODULE (A8)
LOCAL
* USR3025L - Steplibs
01 #LIB (I1)
01 USR3025L
02 INPUTS
03 ACTION (A01) /* 'D', 'A', 'I', 'P'
02 INPUT-OUTPUTS
03 STEPLIB-ID (A08/1:8) /* ID of steplib
03 DBID (I04/1:8) /* DBID of steplib
03 FNR (I04/1:8) /* FNR of steplib
03 PASSWORD (A08) /* Input for ACTION 'A'
03 CIPHERCODE (N08) /* Input for ACTION 'A'
03 POSITION (N01) /* Pos. of lib to be added/deleted
03 AST-STEPLIB (A08) /* Value of *STEPLIB
03 AST-DBID (I04) /* DBID of *STEPLIB
03 AST-FNR (I04) /* FNR of *STEPLIB
03 NUMBER-ACTIVE (N01) /* Number of active steplibs
02 OUTPUTS
03 RESPONSE (I04) /* Error code
03 INFOTEXT (A65) /* Text for RESPONSE field
01 USR3025N
02 VERSION (I01) INIT <0>
01 REDEFINE USR3025N
02 EXTENDED-PARMS
03 EXTENDED-DATA (A01/1:1)
* USR0330L - Object Info
1 #CBDIR (B94)
1 REDEFINE #CBDIR
2 FILLER 1X
2 #CBDIR-OPT2 (A01)
2 #CBDIR-RSP1 (I02)
2 #CBDIR-RSP2 (I02)
2 FILLER 20X
2 #CBDIR-NAME (A64)
2 REDEFINE #CBDIR-NAME
3 #CBDIR-NLIB (A08)
3 #CBDIR-NNAM (A08)
2 #CBDIR-DBID (B02)
2 REDEFINE #CBDIR-DBID
3 #CBDIR-DBID-H (B01)
3 #CBDIR-DBID-L (B01)
2 #CBDIR-FNR (B02)
2 REDEFINE #CBDIR-FNR
3 #CBDIR-FNR-H (B01)
3 #CBDIR-FNR-L (B01)
/*
1 #DIR-OB1 (B100/1:3) /* saved object directory
1 REDEFINE #DIR-OB1
2 NATVERSM (A4)
2 NATVER (A4)
2 NATSM (A4)
2 REDEFINE NATSM
3 NATSMN (N4)
2 USERID (A8)
2 TID (A8)
2 TIME (A8)
2 DATE (A8)
2 OBJTYPE (A1) /* Internal object type ('F' is 'Program')
2 OBJ-LONGNAME (A11)
2 DIR-STATE (A12)
2 CREATE-LIB (A8)
2 CREATE-OBJ-NAME (A8)
2 TERM-USER (A8)
2 SA-SIZE (I4)
2 REC-SIZE (I2)
2 DEV-MODE (A15)
2 SAV-CAT-DATE-TIME (T)
2 OP-SYSTEM (A8)
2 TP-SYSTEM (A8)
2 TA-NAME (A8)
2 VCS-IAPPLID (A8)
2 REDEFINE VCS-IAPPLID
3 APPL-ID (B2)
3 APPL-VER (B2)
3 CNTL-VER (B2)
3 OBJ-VER (B2)
2 AIV-LENGTH (I4)
2 BP-SIZE (I4)
2 U-SIZE (I2)
2 INV-SUBTAB (I2)
2 DEF-SUBTAB (I2)
2 TURBO-CODE (A3)
2 RECAT-POSS (A3)
2 OBJ-RELINKED (A3)
2 TIMESTMP (B8)
2 TURBO-CODE-LEN (I4)
2 GDA-SIZE (I2)
2 NUM-SUBR (I2)
2 NUM-GDA (I2)
2 NUM-REP (I2)
2 NUM-WFILE (I2)
/*
1 #DIR-OB2 (B100/1:3) /* cataloged object directory
1 REDEFINE #DIR-OB2
2 NATVERSM (A4)
2 NATVER (A4)
2 NATSM (A4)
2 REDEFINE NATSM
3 NATSMN (N4)
2 USERID (A8)
2 TID (A8)
2 TIME (A8)
2 DATE (A8)
2 OBJTYPE (A1) /* Internal object type ('F' is 'Program')
2 OBJ-LONGNAME (A11)
2 DIR-STATE (A12)
2 CREATE-LIB (A8)
2 CREATE-OBJ-NAME (A8)
2 TERM-USER (A8)
2 SA-SIZE (I4)
2 REC-SIZE (I2)
2 DEV-MODE (A15)
2 SAV-CAT-DATE-TIME (T)
2 OP-SYSTEM (A8)
2 TP-SYSTEM (A8)
2 TA-NAME (A8)
2 VCS-IAPPLID (A8)
2 REDEFINE VCS-IAPPLID
3 APPL-ID (B2)
3 APPL-VER (B2)
3 CNTL-VER (B2)
3 OBJ-VER (B2)
2 AIV-LENGTH (I4)
2 BP-SIZE (I4)
2 U-SIZE (I2)
2 INV-SUBTAB (I2)
2 DEF-SUBTAB (I2)
2 TURBO-CODE (A3)
2 RECAT-POSS (A3)
2 OBJ-RELINKED (A3)
2 TIMESTMP (B8)
2 TURBO-CODE-LEN (I4)
2 GDA-SIZE (I2)
2 NUM-SUBR (I2)
2 NUM-GDA (I2)
2 NUM-REP (I2)
2 NUM-WFILE (I2)
2 DUMMY (A10)
2 GDA-NAME (A8)
END-DEFINE
* Look for the object in the libraries and return its extension character
FOR #LIB = 0 TO 8 /* For *library and each steplib
IF #LIB = 0
#CBDIR-NLIB := *LIBRARY-ID
ELSE /* Check the steplibs
IF #LIB = 1
USR3025L.ACTION := 'D' /* Display active steplibs
CALLNAT 'USR3025N' USR3025L USR3025N.EXTENDED-PARMS
END-IF
IF USR3025L.STEPLIB-ID(#LIB) = ' '
RESET S$OBJTYP
ESCAPE ROUTINE /* Give up
END-IF
#CBDIR-NLIB := USR3025L.STEPLIB-ID(#LIB)
#CBDIR-DBID := USR3025L.DBID (#LIB)
#CBDIR-FNR := USR3025L.FNR (#LIB)
END-IF
/* Get the object info
#CBDIR-NNAM := #MODULE
#CBDIR-OPT2 := 'E' /* Read exactly specified object
CALLNAT 'USR0330N' #CBDIR #DIR-OB1 (*) #DIR-OB2 (*)
DECIDE FOR EVERY CONDITION
WHEN #CBDIR-RSP2 = 0
S$OBJTYP := #DIR-OB2.OBJTYPE
WHEN #CBDIR-RSP1 = 0
S$OBJTYP := #DIR-OB1.OBJTYPE
WHEN ANY
DECIDE ON FIRST S$OBJTYP
VALUE 'P' S$OBJTYP := 'A' /* .NSA
VALUE 'G' S$OBJTYP := 'C' /* .NSC
VALUE 'C' S$OBJTYP := 'G' /* .NSG
VALUE 'F' S$OBJTYP := 'P' /* .NSP
NONE IGNORE
END-DECIDE
ESCAPE ROUTINE /* Got it
WHEN NONE IGNORE
END-DECIDE
END-FOR /* #LIB
END-FUNCTION /* S$OBJTYP
END
That’s great. Of course it is not fast as it is trying each steplib by force, but that’s not an issue for error processing. Thanks for letting me know it helped you!