[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 770
  • Last Modified:

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






0
BrianMc1958
Asked:
BrianMc1958
  • 7
  • 2
  • 2
  • +1
1 Solution
 
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
NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

 
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
 
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

Featured Post

Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

  • 7
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now