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






BrianMc1958Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Dave FordSoftware Developer / Database AdministratorCommented:
This works for me:

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
0
Dave FordSoftware Developer / Database AdministratorCommented:
Oops ... I just realized you're looking for the LIBRARY name, not the program name. I'll keep looking.

Sorry!
-- Dave
0
daveslaterCommented:
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
0
Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

daveslaterCommented:
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:'CSTK0100':JobIdInf    
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
0
daveslaterCommented:
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
0
Mind_nlCommented:
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...
0
Mind_nlCommented:
Oh hold on, thats what the API does as well, get the programs call-stack...
0
BrianMc1958Author Commented:
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
0
daveslaterCommented:
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

0
daveslaterCommented:
ps
give it ago, it is a lot easier than trying it in CL.

0
daveslaterCommented:
Hi again

here is the basics of a CL program. It will need to be in the main CL proc. I thinke the type needs to be CLLE

PGM                                                                        
             DCL        VAR(&VAR) TYPE(*CHAR) LEN(2000)                    
             DCL        VAR(&IA) TYPE(*CHAR) LEN(4)                        
             DCL        VAR(&IB) TYPE(*CHAR) LEN(4)                        
             DCL        VAR(&IC) TYPE(*CHAR) LEN(4)                        
             DCL        VAR(&ID) TYPE(*CHAR) LEN(4)                        
             DCL        VAR(&IE) TYPE(*CHAR) LEN(4)                        
             DCL        VAR(&IF) TYPE(*CHAR) LEN(4)                        
             DCL        VAR(&Error) TYPE(*CHAR) LEN(15)                    
             DCL        VAR(&Job) TYPE(*CHAR) LEN(56)                      
                                                                           
             DCL        VAR(&J1) TYPE(*CHAR) LEN(26) VALUE('*')            
             DCL        VAR(&J2) TYPE(*CHAR) LEN(16)                        
             DCL        VAR(&J3) TYPE(*CHAR) LEN(2) VALUE(X'0000')          
             DCL        VAR(&J4) TYPE(*CHAR) LEN(8) +                      
                          VALUE(X'0000000000000000')                        
                                                                           
             DCL        VAR(&NA) TYPE(*DEC) LEN(10 0)                      
             DCL        VAR(&PGM) TYPE(*CHAR) LEN(10)                      
             DCL        VAR(&LIB) TYPE(*CHAR) LEN(10)                    
                                                                       
                                                                       
            CHGVAR    %BIN(&IA) VALUE(&NA)                              
            CHGVAR    %BIN(&IB) VALUE(&NA)                              
            CHGVAR    %BIN(&IC) VALUE(&NA)                              
            CHGVAR    %BIN(&ID) VALUE(&NA)                              
            CHGVAR    %BIN(&IE) VALUE(&NA)                              
            CHGVAR     VAR(&na) VALUE(2000)                            
            CHGVAR    %BIN(&IF) VALUE(&NA)                              
                                                                       
            CHGVAR     VAR(&VAR) VALUE(&IA *CAT &IB *CAT &IC *CAT +    
                         &ID *CAT &IE *CAT &IF *CAT &ERROR)            
                                                                       
            CHGVAR     VAR(&na) VALUE(1)                                
            CHGVAR    %BIN(&Ia) VALUE(&NA)                              
            CHGVAR     VAR(&job) VALUE(&j1 *CAT &j2 *CAT &j3 *CAT +    
                         &ia *CAT &j4)                                  
                                                                       
            CALL       PGM(QWVRCSTK) PARM(&VAR &IF 'CSTK0100' &JOB +    
                          'JIDF0100' &ERROR)    
                                                 
             CHGVAR &PGM %SST(&VAR 57 10)        
             CHGVAR &LIB %SST(&VAR 67 10)        
                                                 
ENDPGM                                          


Dave
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
BrianMc1958Author Commented:
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
0
daveslaterCommented:
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

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
IBM System i

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.