Have you tried this?

Callp(e)  Die('Crush, kill, destroy...')
If  %Error()   //  Die procedure ended in error.
Endif

(Sorry, you've had to have been a fan of the old Lost in Space show to
appreciate that one.)

You're problem is that you need to send the message to the control boundary
not *PRV or *SAME as we're used to. Use *CTLBDRY or whatever that value is,
in stead of '*' and see if it works. 



-Bob Cozzi
www.RPGxTools.com
If everything is under control, you are going too slow.
- Mario Andretti


-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of Rich Duzenbury
Sent: Thursday, March 17, 2005 1:13 PM
To: RPG400-L unknown
Subject: Proper way to die...

Hey all,

I'm trying to figure out the correct way to throw an exception from an
RPGLE program.  

I'm working on a program where I need to use the profile handle api's to
become another user for a short time.  Should any of the api calls fail,
I want to signal an exception, and if the new user is active, be sure
that it's priviliges get dropped.

(See test code below).

I'm calling QMHSNDPM to signal the exception, and I've wrapped it into a
procedure to make it easier to call, as in die('Uh-oh something bad
happened').

In the call to the send program message api, if I set the call stack
entry to '*', and the call stack count to 0, then the message is:

Message ID: RNQ0202
Type: Inquiry
Sev: 99

The call to 'DIE' ended in error.

RPG procedure ZZZ_PH in program LIB/ZZZ_PH at statement 9700 call
program or procedure DIE which ended in error.

This is not terrible, as the program and statement number are listed in
the second level text, BUT, I really need the message to be:

The call to ZZZ_PH ended in error.

Mainly because I might have a hundred programs using the die procedure,
and It would be much easier to debug if the _caller_ of die is listed in
the first level text.

So, I started playing around with the call stack entry and the call
stack count.

In the case where the call stack entry is the name of the program
('ZZZ_PH') and the call stack count is set to zero, I get the same
results as above, namely an RNQ0202 inquiry, sev 99, and the same text.

In the case where the call stack entry is the name of the program, and
the call stack count is set to one, I then receive a much different
result.  

In this case, I receive no inquiry message, and the program returns to
the command line with the following error listed at the bottom of the
screen:

Message CEE9901
Type INFO

Application error.  CPF9898 unmonitored by ZZZ_PH at statement *N,
instruction x'0000'.

Then application ended abnormally because an exception occurred and was
not handled.

So, what is the proper way to die, such that the _caller_ of the die
procedure is listed in the first level text?  Can it be done?

Thank you.


     h option(*srcstmt:*nodebugio) dftactgrp(*no) bnddir('QC2LE')

     D  userid         s             10a
     D  password       s             10a
     D  msg            s             50a
     D  rc             s             10i 0
     D  p_abend        s               *   procptr
     D  token          s               *
     D  feedback       s             12a

      * Profile handle 1, our current profile handle
     D ph1             ds                  qualified
     D  handle                       12a
     D  loaded                         n
     D  active                         n

      * Profile handle 2, our current profile handle
     D ph2             ds                  qualified
     D  handle                       12a
     D  loaded                         n
     D  active                         n

      * universal api error data structure
     D error           ds                  qualified
     D  provided                     10i 0
     D  available                    10i 0
     D  msgid                         7a
     D  rsvd                          1a
     D  msgdta                       80

      * program status data structure
     D sds            sds                  qualified
     D  proc             *proc

      * get profile handle
     D getph           pr
extproc('QsyGetProfileHandle')
     D  handle                       12a
     D  userid                       10a   const
     D  password                    512a   const options(*varsize)
     D  pw_length                    10i 0 value
     D  pw_ccsid                     10u 0 value
     D  error                              likeds(error)

      * set profile handle
     D setph           pr
extproc('QsySetToProfileHandle')
     D  handle                       12a
     D  error                              likeds(error)

      * release profile handle
     D rlsph           pr
extproc('QsyReleaseProfileHandle')
     D  handle                       12a
     D  error                              likeds(error)

      * cancellation cleanup
     D ceertx          pr                  extproc('CEERTX')
     D  procedure                      *   procptr
     D  token                          *
     D  feedback                     12a

      * local cleanup routine
     D cleanup         pr

     D die             pr
     D  message                     512a   const options(*varsize)

     D whoami          pr                  extpgm('ZZZ_WHOAMI')

     C     *entry        plist
     C                   parm                    userid
     C                   parm                    password

      /free

          error.provided = %size(error);

          // Install cancel handler.  In the case that this code
          // somehow crashes, this will ensure that cleanup is
          // run and drops the priviliges of the passed in userid
          p_abend = %paddr('CLEANUP');
          ceertx(p_abend : token : feedback);

          whoami();

          // save our handle so we can restore it later
          getph(ph1.handle : '*CURRENT' : '*NOPWD' : 6 : 0 : error);
          if error.available > 0;
              die('getph-nopwd Error: ' + error.msgid + ' ' +
                    error.msgdta);
          endif;
          ph1.loaded = '1';
          ph1.active = '1';

          // get the handle for the asked for userid/password
          getph( ph2.handle : userid : password :
                     %len(%trim(password)) : 0 : error);
          if error.available > 0;
                 die('getph-withpw Error: ' + error.msgid + ' ' +
                   error.msgdta);
          endif;
          ph1.loaded = '1';

          // set profile to new handle
          setph( ph2.handle : error);
          if error.available > 0;
              die('setph2 Error: ' + error.msgid +
                            ' ' + error.msgdta);
          endif;
          ph1.active = '0';
          ph2.loaded = '1';
          ph2.active = '1';

          whoami();

          cleanup();

          whoami();

          *inlr = '1';
      /end-free

      *

**********************************************************************
      * Cleanup the handles and return to base handle

**********************************************************************
      *
     P cleanup         b
     D cleanup         pi

      /free
         dsply 'Cleaning up';

          // return to original profile if necessary
          if ph2.active = '1';
              setph( ph1.handle : error);
          ph1.active = '1';
          ph2.active = '0';
          endif;

          if ph2.loaded = '1';
              rlsph( ph2.handle : error);
              ph2.loaded = '0';
          endif;

          if ph1.loaded = '1';
              rlsph( ph1.handle : error);
              ph1.loaded = '0';
          endif;
      /end-free
     P                 e

      *

**********************************************************************
      * die - kill ourself

**********************************************************************
      *
     P die             b

     D die             pi
     D  message                     512a   const options(*varsize)

     D  short_msg      s             50a
     D  msgkey         s              4a
     D  msgid          c                   'CPF9898'
     D  msgf           c                   'QCPFMSG   *LIBL     '

     D sndpgmmsg       pr                  extpgm('QMHSNDPM')
     D  msgid                         7a   const
     D  msgf                         20a   const
     D  msgdta                      512a   const options(*varsize)
     D  msgdtalen                    10i 0 const
     D  msgtype                      10a   const
     D  callstkent                   10a   const
     D  callstkcnt                   10i 0 const
     D  msgkey                        4a
     D  error                              likeds(error)

      /free
         sndpgmmsg( 'CPF9898' : 'QCPFMSG   *LIBL' :
                    %trim(message) : %len(%trim(message)) :
                    '*ESCAPE' :
                    sds.proc :
                    0 :
                    msgkey :
                    error);
      /end-free
     P                 e
--
Regards,
Rich

Current Conditions in Des Moines, IA
Overcast
Temp 51.8F


-- 
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.





As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.