/* REXX                                    */
/* LOCATE CONTOKEN FOR A GIVEN DB2 PROGRAM */
/*                                         */
/* (C) ISAAC YASSIN - 2005.                */
/*******************************************/
TRACE O
PARSE UPPER ARG MEM
SAY " LOOKING FOR CONTOKEN OF: " MEM
ZZ=MSG(OFF)

LIBD.0=3
LIBD.1 = 'DEVL.DB2.DBRMLIB('MEM")"
LIBD.2 = 'TEST.DB2.DBRMLIB('MEM")"
LIBD.3 = 'PROD.DB2.DBRMLIB('MEM")"

LIBL.0=4
LIBL.1 = 'DEVL.SPF.LOAD'
LIBL.2 = 'TEST.SPF.LOAD'
LIBL.3 = 'DEVL.CICSAPPL.LOADLIB'
LIBL.4 = 'TEST.CICSAPPL.LOADLIB'

DO I=1 TO LIBD.0;
  CALL GETOKEN;
  IF RC = 0 THEN
  DO
     SAY "  + LOOKING FOR LOAD MODULE INFO."
     DO J=1 TO LIBL.0;
        CALL GETLOAD;
     END;
   END;
 END;
 "FREE  F(INDBRM) "
 RETURN
 /****************************************************************/
 GETOKEN:
 RCC1=0;RCC2=0;
 IF SYSDSN(LIBD.I) = 'OK' THEN
 DO
    SAY " ";SAY LIBD.I;SAY COPIES('=',30);
    "ALLOC F(INDBRM) DA("LIBD.I") REUSE"
    IF RC > 0 THEN RCC1 = RC
    IF RCC1 = 0 THEN
    "EXECIO 1 DISKR INDBRM(STEM LIN. FINIS)"
    IF RC > 0 THEN RCC2 = RC
    IF RCC2 = 0 THEN
    DO
      LIBTOKEN = SUBSTR(LIN.1,25,8)
      CONTOKEN = STRIP(C2X(LIBTOKEN))
      LIBTOKEN = RIGHT(CONTOKEN,8)||LEFT(CONTOKEN,8)    /* COBOL */
      SAY " "MEM '    ' CONTOKEN "     LOAD=" LIBTOKEN
    END
 END
 ELSE SAY " "MEM" NOT FOUND IN DBRM LIBRARY " LIBD.I ;

 RX = RCC1+RCC2
 RETURN RX
 /****************************************************************/
 GETLOAD:

"ALLOC F(DDLOAD) DA("LIBL.J") SHR REUSE"
IF RC > 0 THEN
DO
  SAY "ERROR ON ALLOCATION OF "LIBL.J
  RETURN
END
ADDRESS ISPEXEC "LMINIT  DATAID(LLIB) DDNAME(DDLOAD) ENQ(SHR)"
ADDRESS ISPEXEC "LMOPEN  DATAID("LLIB") OPTION(INPUT)"
ADDRESS ISPEXEC "LMMFIND DATAID("LLIB") MEMBER("MEM")"
FIND_RC = RC
TOKEN_FOUND = 0 ;
IF FIND_RC = 0 THEN
DO
   ADDRESS ISPEXEC "LMGET  DATAID("LLIB") MODE(INVAR)" ,
           "DATALOC(LOADLINE) DATALEN(LENVAR) MAXLEN(32760)"
   GET_RC=RC
   DO WHILE (GET_RC = 0 & TOKEN_FOUND = 0)
      LOADLIN1=C2X(SUBSTR(LOADLINE,1,16380))
      LOADLIN2=C2X(SUBSTR(LOADLINE,16381))
      IF POS(LIBTOKEN,LOADLIN1) + ,
         POS(LIBTOKEN,LOADLIN2) > 0 THEN TOKEN_FOUND = 1
      ADDRESS ISPEXEC "LMGET  DATAID("LLIB") MODE(INVAR)" ,
              "DATALOC(LOADLINE) DATALEN(LENVAR) MAXLEN(32760)"
     GET_RC=RC ;
   END
   IF TOKEN_FOUND = 1 THEN
        SAY "   @@@  CONTOKEN "LIBTOKEN" WAS FOUND IN " LIBL.J
   ELSE SAY "   ///  CONTOKEN "LIBTOKEN" NOT FOUND IN " LIBL.J
END
ELSE SAY "       MEMBER "MEM" NOT FOUND IN " LIBL.J;
      LOADLIN1=C2X(SUBSTR(LOADLINE,1,16380))
      LOADLIN2=C2X(SUBSTR(LOADLINE,16381))
      IF POS(LIBTOKEN,LOADLIN1) + ,
         POS(LIBTOKEN,LOADLIN2) > 0 THEN TOKEN_FOUND = 1
      ADDRESS ISPEXEC "LMGET  DATAID("LLIB") MODE(INVAR)" ,
              "DATALOC(LOADLINE) DATALEN(LENVAR) MAXLEN(32760)"
     GET_RC=RC ;
   END
   IF TOKEN_FOUND = 1 THEN
        SAY "   @@@  CONTOKEN "LIBTOKEN" WAS FOUND IN " LIBL.J
   ELSE SAY "   ///  CONTOKEN "LIBTOKEN" NOT FOUND IN " LIBL.J
END
ELSE SAY "       MEMBER "MEM" NOT FOUND IN " LIBL.J;
ADDRESS ISPEXEC "LMCLOSE DATAID("LLIB")"
ADDRESS ISPEXEC "LMFREE  DATAID("LLIB")"

RETURN