BrianMc1958
asked on
How can a CL proc know it's own library?
Dear AS/400 Experts,
This is a surprisingly tough question.
I have a CL procedure that must figure out at run-time which library it is being run from. Checking the library list is not sufficient.
I had searched EE for an answer, and found the following clever, incredibly convoluted solution:
OVRPRTF FILE(QPPGMDMP) TOFILE(NOSUCHLIB/NOSUCHFIL )
DMPCLPGM
MONMSG MSGID(CPF0570 CPF4101) EXEC(DO)
RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA)
CHGVAR &OBJLIB (%SST(&MSGDTA 11 10))
It actually generates an error message, which happens to contain the name of the library I am seeking.
Unfortunately, it also causes any subsequent COBOL dumps to fail. So I need another method.
I have 15 years of AS/400 experience and I can't answer this basic question! How about you experts?
Thanks,
BrianMc1958
This is a surprisingly tough question.
I have a CL procedure that must figure out at run-time which library it is being run from. Checking the library list is not sufficient.
I had searched EE for an answer, and found the following clever, incredibly convoluted solution:
OVRPRTF FILE(QPPGMDMP) TOFILE(NOSUCHLIB/NOSUCHFIL
DMPCLPGM
MONMSG MSGID(CPF0570 CPF4101) EXEC(DO)
RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA)
CHGVAR &OBJLIB (%SST(&MSGDTA 11 10))
It actually generates an error message, which happens to contain the name of the library I am seeking.
Unfortunately, it also causes any subsequent COBOL dumps to fail. So I need another method.
I have 15 years of AS/400 experience and I can't answer this basic question! How about you experts?
Thanks,
BrianMc1958
Oops ... I just realized you're looking for the LIBRARY name, not the program name. I'll keep looking.
Sorry!
-- Dave
Sorry!
-- Dave
Hi
if the cl is in the library list, you can just do a dspobjd on the program name to the file, and read the file.
If it is a qualified call then I will need have a play on monday.
Dave
if the cl is in the library list, you can just do a dspobjd on the program name to the file, and read the file.
If it is a qualified call then I will need have a play on monday.
Dave
Ok for 500 points here is a program ( know I'm cheep but I like API's)
D GetCaller PR Extpgm('QWVRCSTK')
D 2000
D 10I 0
D 8 CONST
D 56
D 8 CONST
D 15
D Var DS 2000
D BytAvl 10I 0
D BytRtn 10I 0
D Entries 10I 0
D Offset 10I 0
D EntryCount 10I 0
D VarLen S 10I 0 Inz(%size(Var))
D ApiErr S 15
D JobIdInf DS
D JIDQName 26 Inz('*')
D JIDIntID 16
D JIDRes3 2 Inz(*loval)
D JIDThreadInd 10I 0 Inz(1)
D JIDThread 8 Inz(*loval)
D Entry DS 256
D EntryLen 10I 0
D PgmNam 10 Overlay(Entry:25)
D PgmLib 10 Overlay(Entry:35)
**
DCaller S 20
DThisPgm S LIKE(PGMNAM)
**
C *ENTRY PLIST
C PARM caller
** Always exit with LR
C Eval *InLR = *on
** Call API to get full pgmstack
C CallP GetCaller(Var:VarLen:'CSTK 0100':JobI dInf
C :'JIDF0100':ApiErr)
**get the first entry, this is this program
C Eval Entry = %subst(Var:Offset + 1)
C Eval ThisPgm = PGMNAM
** Prevent offset error
c Eval EntryCount = EntryCount -1
**Process the number on entries returned
**till program does not match this one
C Do EntryCount
C Eval Offset = Offset + EntryLen
C Eval Entry = %subst(Var:Offset + 1)
**return caller details
C IF PGMNAM <> ThisPgm
C EVAL Caller = PgmNam + PgmLib
C leave
C ENDIF
C Enddo
**& exit
C RETURN
Dave
D GetCaller PR Extpgm('QWVRCSTK')
D 2000
D 10I 0
D 8 CONST
D 56
D 8 CONST
D 15
D Var DS 2000
D BytAvl 10I 0
D BytRtn 10I 0
D Entries 10I 0
D Offset 10I 0
D EntryCount 10I 0
D VarLen S 10I 0 Inz(%size(Var))
D ApiErr S 15
D JobIdInf DS
D JIDQName 26 Inz('*')
D JIDIntID 16
D JIDRes3 2 Inz(*loval)
D JIDThreadInd 10I 0 Inz(1)
D JIDThread 8 Inz(*loval)
D Entry DS 256
D EntryLen 10I 0
D PgmNam 10 Overlay(Entry:25)
D PgmLib 10 Overlay(Entry:35)
**
DCaller S 20
DThisPgm S LIKE(PGMNAM)
**
C *ENTRY PLIST
C PARM caller
** Always exit with LR
C Eval *InLR = *on
** Call API to get full pgmstack
C CallP GetCaller(Var:VarLen:'CSTK
C :'JIDF0100':ApiErr)
**get the first entry, this is this program
C Eval Entry = %subst(Var:Offset + 1)
C Eval ThisPgm = PGMNAM
** Prevent offset error
c Eval EntryCount = EntryCount -1
**Process the number on entries returned
**till program does not match this one
C Do EntryCount
C Eval Offset = Offset + EntryLen
C Eval Entry = %subst(Var:Offset + 1)
**return caller details
C IF PGMNAM <> ThisPgm
C EVAL Caller = PgmNam + PgmLib
C leave
C ENDIF
C Enddo
**& exit
C RETURN
Dave
Just a thought
If you wanted to make it more efficient.
You could make this in to a service program, convert the CL to a CLLE and bind it. It only makes sence it if it is used a lot, but if it is then it is well worth it.
Dave
If you wanted to make it more efficient.
You could make this in to a service program, convert the CL to a CLLE and bind it. It only makes sence it if it is used a lot, but if it is then it is well worth it.
Dave
Dave, that probably works but I think the library is allready in the program data structure...
However this is the case for a RPG program I don't think there is anything like that in CL what you could do is try a
DSPJOB OUTPUT(*PRINT) OPTION(*PGMSTK) then copy the spooled file to a PF and use a query to get your program/library from the callstack...
However this is the case for a RPG program I don't think there is anything like that in CL what you could do is try a
DSPJOB OUTPUT(*PRINT) OPTION(*PGMSTK) then copy the spooled file to a PF and use a query to get your program/library from the callstack...
Oh hold on, thats what the API does as well, get the programs call-stack...
ASKER
Dear Experts,
Thank you for all your help, but I'm afraid I'm still a little stymied.
To Dave Slater: I should have said, I don't know RPG. So that won't really work for me. Also, the library is NOT in the library list.
I am thinking about trying the QWVRCSTK API, which returns the call stack. Would anyone have a working CL example of implementing this?
Thanks again, Experts!
--BrianMc1958
Thank you for all your help, but I'm afraid I'm still a little stymied.
To Dave Slater: I should have said, I don't know RPG. So that won't really work for me. Also, the library is NOT in the library list.
I am thinking about trying the QWVRCSTK API, which returns the call stack. Would anyone have a working CL example of implementing this?
Thanks again, Experts!
--BrianMc1958
Hi BrianMc1958
You do not need to know RPG. The program is complete and will compile, all you only need to:
create a source file
CRTSRCPF MYLIB/QRPGLESRC
wrkmbrpdm MYLIB/QRPGLESRC
F6 to create a new member, call the program GetCaller
then cut and pase the code in sections
F3 to exit
Compile using option 14
in the CL
call Getcaller(&pgmLib)
Dave
You do not need to know RPG. The program is complete and will compile, all you only need to:
create a source file
CRTSRCPF MYLIB/QRPGLESRC
wrkmbrpdm MYLIB/QRPGLESRC
F6 to create a new member, call the program GetCaller
then cut and pase the code in sections
F3 to exit
Compile using option 14
in the CL
call Getcaller(&pgmLib)
Dave
ps
give it ago, it is a lot easier than trying it in CL.
give it ago, it is a lot easier than trying it in CL.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Dear Dave,
Thank you. Thank you. Thank you. I can't believe you would actually write a whole program for me! What's better, it works!
Thank you to everyone else, too.
Yours,
BrianMc1958
Thank you. Thank you. Thank you. I can't believe you would actually write a whole program for me! What's better, it works!
Thank you to everyone else, too.
Yours,
BrianMc1958
Hi
Glad to be of assistance.
I hope you have made it a bit more readable :-). If you look back to the RPG example you can see what the variables actually mean.
Keep looking at the site, with your experience you can help other people.
If you want you can send me an email at the email address in my profile with the things that interest you. I can then call on your experience if a question comes along.
We all know the 400 is a beast of a computer and the more experts we have the more we learn
Dave
Glad to be of assistance.
I hope you have made it a bit more readable :-). If you look back to the RPG example you can see what the variables actually mean.
Keep looking at the site, with your experience you can help other people.
If you want you can send me an email at the email address in my profile with the things that interest you. I can then call on your experience if a question comes along.
We all know the 400 is a beast of a computer and the more experts we have the more we learn
Dave
PGM
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&PGMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
SNDPGMMSG MSG(' ') TOPGMQ(*SAME) MSGTYPE(*INFO) +
KEYVAR(&MSGKEY)
RCVMSG PGMQ(*SAME) MSGTYPE(*INFO) RMV(*YES) +
SENDER(&SENDER)
CHGVAR VAR(&PGMNAME) VALUE(%SST(&SENDER 56 10))
ENDPGM