|
midrange.com
Why is SQLSTT="Call stack entry does not exist"?
Using the IBM distributed debugger I am trying to look at SQLSTT. At
times it has values, however at the time that are in the obvious comments
below it is equal to "Call stack entry does not exist". Why?
/DEFINE HSpec
/INCLUDE ROUTINES/QRPGLESRC,HSPEC
/UNDEFINE HSpec
***************************************************************************
* Program: Analyze the email journal entries for stuck emails and
handle *
* accordingly. *
* *
* Reference material: *
* IBM Information Center, a sample url, (at least for V5R2), is: *
* http://publib.boulder.ibm.com/iseries/v5r2/ic2924/index.htm *
* Networking, TCP/IP, E-mail, Troubleshoot e-mail, Check component
*
* journals. *
* *
* All emails, (other than Domino), launched with either SNDDST or
the API *
* QTmmSendMail, (used by the command SNDEMAIL), are logged in the
journal *
* QZMF. Those launched with SNDDST will have a function identifier
of H *
* for a subtype of H1. Those launched with SNDEMAIL will have a
function *
* identifier of E for a subtype of EH. *
* Regardless of how they were launced, once they leave MSF and go to
SMTP *
* there will be a P2 record for each recepient. Then there should
either *
* be an 82 (sent), or an 83 (undeliverable) for each recipient. *
* Looking at H1's, or EH's, without P2's will show those stuck in
MSF. *
* Looking at P2's without matching 82's or 83's will show those
stuck, *
* ?elsewhere?. *
* *
* Modification log: *
* 01/07/04 by R.Berendt, CCP Group Dekko Services, LLC *
* Created. *
* *
* Compilation instructions: *
* (no special instructions this time.) *
* *
***************************************************************************
/DEFINE DSpec
/INCLUDE ROUTINES/QRPGLESRC,SRVPGMCPY
D AnyStuckMSF PR n
D DeclareMSF PR
D OpenMSF PR
D FetchMSF PR
D CloseMSF PR
D AnyLimbo PR n
D DeclareLimbo PR
D OpenLimbo PR
D FetchLimbo PR
D CloseLimbo PR
D JrnlEntries ds Dim(30) Qualified
D Subtype like(wSubtype)
D Tranid like(wTranid)
D NbrJrnlEntries s 5i 0 inz(%elem(JrnlEntries))
D CurJrnlEntries s 5i 0 inz(0)
D wSubtype s 2a inz(*loval)
D wTranid s 29a inz(*loval)
/UNDEFINE DSpec
C/EXEC SQL
C+ Set Option
C+ Naming = *Sys,
C+ Commit = *None,
C+ UsrPrf = *User,
C+ DynUsrPrf = *User,
C+ CloSqlCsr = *EndMod
C/END-EXEC
/free
AnyStuckMSF(); // Check for emails that have not went from MSF to
SMTP
AnyLimbo(); // Check for any that have declared a delivery address
to SMTP
// but have not either been delivered or been declared
undeliverable.
*inlr=*on;
return;
/end-free
/EJECT
P AnyStuckMSF B
// Check for any emails that have not went from MSF to SMTP.
// Looking at H1's, or EH's, without P2's will show those stuck in
MSF.
D AnyStuckMSF PI n
D AreAnyStuck s n
/free
AreAnyStuck=*off;
reset JrnlEntries; // Clear the array holding journal entries
reset CurJrnlEntries; // reset the counter of how many hits
DeclareMSF();
// A cursor declare has no effect on either SQLCOD or SQLSTT
OpenMSF();
DoU sqlstt<>'00000' or CurJrnlEntries>=NbrJrnlEntries;
// Do while we are able to fetch records from the cursor
// and the array is not full.
FetchMSF();
Select;
When Sqlstt='02000'; // End of fetch rows
Leave;
When Sqlstt<>'00000'; // any other sql error
Leave;
EndSl;
CurJrnlEntries+=1;
JrnlEntries(CurJrnlEntries).Subtype=wSubtype;
JrnlEntries(CurJrnlEntries).Tranid=wTranid;
AreAnyStuck=*on;
EndDo; // Fetch a row from the cursor
CloseMSF();
return AreAnyStuck;
/end-free
P AnyStuckMSF E
/EJECT
P DeclareMSF B
D DeclareMSF PI
C/EXEC SQL
C+ Declare MSF cursor for
C+ with
C+ T1 (Tranid, Subtype) as
C+ (select substr(joesd,39,29),
C+ substr(joesd,70, 2)
C+ from qtemp/ZMFSTUFF
C+ where substr(joesd,70, 2) in('EH','H1')
C+ ),
C+ T2 (Tranid, Subtype) as
C+ (select substr(joesd,39,29),
C+ substr(joesd,70, 2)
C+ from qtemp/ZMFSTUFF
C+ where substr(joesd,70, 2) = 'P2'
C+ )
C+ select T1.Tranid, T1.Subtype
C+ from T1
C+ exception join T2
C+ on T1.Tranid=T2.Tranid
C/END-EXEC
C return
P DeclareMSF E
/EJECT
P OpenMSF B
D OpenMSF PI
C/EXEC SQL
C+ Open MSF
C/END-EXEC
C return
P OpenMSF E
/EJECT
P FetchMSF B
D FetchMSF PI
C/EXEC SQL
C+ Fetch MSF into :wTranid, :wSubtype
C/END-EXEC
C return
P FetchMSF E
/EJECT
P CloseMSF B
D CloseMSF PI
C/EXEC SQL
C+ Close MSF
C/END-EXEC
C return
P CloseMSF E
/EJECT
P AnyLimbo B
// Check for any emails that have not went from MSF to SMTP.
// Looking at H1's, or EH's, without P2's will show those stuck in
MSF.
D AnyLimbo PI n
D AreAnyLimbo s n
/free
AreAnyLimbo=*off;
reset JrnlEntries; // Clear the array holding journal entries
reset CurJrnlEntries; // reset the counter of how many hits
DeclareLimbo();
// A cursor declare has no effect on either SQLCOD or SQLSTT
OpenLimbo();
DoU sqlstt<>'00000' or CurJrnlEntries>=NbrJrnlEntries;
// Do while we are able to fetch records from the cursor
// and the array is not full.
FetchLimbo();
Select;
When Sqlstt='02000'; // End of fetch rows
Leave;
When Sqlstt<>'00000'; // any other sql error
// Yo! Here!
// Ladies and gentleman
// why is SQLSTT="Call stack entry does not exist" in the debugger????
Leave;
EndSl;
CurJrnlEntries+=1;
JrnlEntries(CurJrnlEntries).Subtype=wSubtype;
JrnlEntries(CurJrnlEntries).Tranid=wTranid;
AreAnyLimbo=*on;
EndDo; // Fetch a row from the cursor
CloseLimbo();
return AreAnyLimbo;
/end-free
P AnyLimbo E
/EJECT
P DeclareLimbo B
D DeclareLimbo PI
C/EXEC SQL
C+ Declare Limbo cursor for
C+ with
C+ T1 (Tranid, Subtype, EmailAddress) as
C+ (select substr(joesd,39,29),
C+ substr(joesd,70, 2),
C+ STRIPEMAIL(joesd)
C+ from qtemp/ZMFSTUFF
C+ where substr(joesd,70, 2) = 'P2'
C+ and stripemail(joesd)<>'0'
C+ ),
C+ T2 (Tranid, Subtype, EmailAddress) as
C+ (select substr(joesd,39,29),
C+ substr(joesd,70, 2),
C+ STRIPEMAIL(joesd)
C+ from qtemp/ZMFSTUFF
C+ where substr(joesd,70, 2) IN('82','83')
C+ and stripemail(joesd)<>'0'
C+ )
C+ select T1.Tranid, T1.Subtype
C+ from T1
C+ exception join T2
C+ on T1.Tranid=T2.Tranid and t1.emailaddress=t2.emailaddress
C/END-EXEC
C return
P DeclareLimbo E
/EJECT
P OpenLimbo B
D OpenLimbo PI
C/EXEC SQL
C+ Open Limbo
C/END-EXEC
C return
P OpenLimbo E
/EJECT
P FetchLimbo B
D FetchLimbo PI
C/EXEC SQL
C+ Fetch Limbo into :wTranid, :wSubtype
C/END-EXEC
C return
P FetchLimbo E
/EJECT
P CloseLimbo B
D CloseLimbo PI
C/EXEC SQL
C+ Close Limbo
C/END-EXEC
C return
P CloseLimbo E
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
