Rational Developer for System z
Enterprise PL/I for z/OS, Version 4.2, Programming Guide

Example of suppressing SQL messages

Figure 108 shows how to modify the user exit to examine the message inserts and suppress two SQL informational messages and one SQL warning message.

Figure 108. Suppressing SQL messages
*Process dft(nodescriptor connected);
*Process or('|') not('!');
*Process limits(extname(31)) rent;

 /********************************************************************/
 /*                                                                  */
 /*  NAME - IBMUEXIT.PLI                                             */
 /*                                                                  */
 /*  DESCRIPTION                                                     */
 /*    User-exit sample program.                                     */
 /*                                                                  */
 /*    Licensed Materials - Property of IBM                          */
 /*    5639-A83, 5639-A24 (C) Copyright IBM Corp. 1992,2011.         */
 /*    All Rights Reserved.                                          */
 /*    US Government Users Restricted Rights-- Use, duplication or   */
 /*    disclosure restricted by GSA ADP Schedule Contract with       */
 /*    IBM Corp.                                                     */
 /*                                                                  */
 /*  DISCLAIMER OF WARRANTIES                                        */
 /*    The following enclosed code is sample code created by IBM     */
 /*    Corporation. This sample code is not part of any standard     */
 /*    IBM product and is provided to you solely for the purpose of  */
 /*    assisting you in the development of your applications.  The   */
 /*    code is provided "AS IS", without warranty of any kind.       */
 /*    IBM shall not be liable for any damages arising out of your   */
 /*    use of the sample code, even if IBM has been advised of the   */
 /*    possibility of such damages.                                  */
 /*                                                                  */
 /********************************************************************/
 /********************************************************************/
 /*                                                                  */
 /*  During initialization, IBMUEXIT is called.  It reads            */
 /*  information about the messages being screened from a text       */
 /*  file and stores the information in a linked list. IBMUEXIT      */
 /*  also sets up the entry points for the message filter service    */
 /*  and termination service.                                        */
 /*                                                                  */
 /*  For each message generated by the compiler, the compiler        */
 /*  calls the message filter registered by IBMUEXIT.  The filter    */
 /*  looks the message up in the linked list previously created      */
 /*  to see if it is one for which some action should be taken.      */
 /*                                                                  */
 /*  The termination service is called at the end of the compile     */
 /*  but does nothing.  It could be enhanced to generates reports    */
 /*  or do other cleanup work.                                       */
 /*                                                                  */
 /********************************************************************/


 pack: package exports(*);

   Dcl
     1 Uex_UIB           native Based( null() ),
       2 Uex_UIB_Length         fixed bin(31),

       2 Uex_UIB_Exit_token     pointer,       /* for user exit's use */

       2 Uex_UIB_User_char_str  pointer,       /* to exit option str  */
       2 Uex_UIB_User_char_len  fixed bin(31),

       2 Uex_UIB_Filename_str   pointer,       /* to source filename  */
       2 Uex_UIB_Filename_len   fixed bin(31),

       2 Uex_UIB_return_code fixed bin(31),    /* set by exit procs   */
       2 Uex_UIB_reason_code fixed bin(31),    /* set by exit procs   */

       2 Uex_UIB_Exit_Routs,                   /* exit entries setat
                                                  initialization      */
         3 ( Uex_UIB_Termination,
             Uex_UIB_Message_Filter,           /* call for each msg   */
            *, *, *, * )
           limited entry (
            *,                                 /* to Uex_UIB          */
            *                                  /* to a request area   */
           );

   /*******************************************************************/
   /*                                                                 */
   /*   request area for initialization exit                          */
   /*                                                                 */
   /*******************************************************************/

   Dcl 1 Uex_ISA native based( null() ),
        2 Uex_ISA_Length fixed bin(31);
   /*******************************************************************/
   /*                                                                 */
   /*   request area for message_filter exit                          */
   /*                                                                 */
   /*******************************************************************/

   Dcl 1 Uex_MFX based( null() ),
        2 Uex_MFX_Length                 fixed bin(31),
        2 Uex_MFX_Facility_Id            char(3),
        2 Uex_MFX_Version                fixed bin(7),
        2 Uex_MFX_Message_no             fixed bin(31),
        2 Uex_MFX_Severity               fixed bin(15),
        2 Uex_MFX_New_Severity           fixed bin(15),
        2 Uex_MFX_Inserts                fixed bin(15),
        2 Uex_MFX_Inserts_Data( 6 ),
          3 Uex_MFX_Ins_Type             fixed bin(7),
          3 Uex_MFX_Ins_Type_Data union unaligned,
            4 *                          char(8),
            4 Uex_MFX_Ins_Bin            fixed bin(31),
            4 Uex_MFX_Ins_Str,
              5 Uex_MFX_Ins_Str_Len      fixed bin(15),
              5 Uex_MFX_Ins_Str_Addr     pointer,
           4 Uex_MFX_Ins_Series,
              5 Uex_MFX_Ins_Series_Sep   char(1),
              5 Uex_MFX_Ins_Series_Addr  pointer;

   dcl uex_Ins_Type_Xb31               fixed bin(15) value(1);
   dcl uex_Ins_Type_Char               fixed bin(15) value(2);
   dcl uex_Ins_Type_Series             fixed bin(15) value(3);

  /*******************************************************************/
   /*                                                                 */
   /*   request area for terminate exit                               */
   /*                                                                 */
   /*******************************************************************/

   Dcl 1 Uex_TSA native based( null() ),
         2 Uex_TSA_Length fixed bin(31);

   /*******************************************************************/
   /*                                                                 */
   /*   severity codes                                                */
   /*                                                                 */
   /*******************************************************************/

   dcl uex_Severity_Normal             fixed bin(15) value(0);
   dcl uex_Severity_Warning            fixed bin(15) value(4);
   dcl uex_Severity_Error              fixed bin(15) value(8);
   dcl uex_Severity_Severe             fixed bin(15) value(12);
   dcl uex_Severity_Unrecoverable      fixed bin(15) value(16);
   
   /*******************************************************************/
   /*                                                                 */
   /*   return codes                                                  */
   /*                                                                 */
   /*******************************************************************/

   dcl uex_Return_Normal               fixed bin(15) value(0);
   dcl uex_Return_Warning              fixed bin(15) value(4);
   dcl uex_Return_Error                fixed bin(15) value(8);
   dcl uex_Return_Severe               fixed bin(15) value(12);
   dcl uex_Return_Unrecoverable        fixed bin(15) value(16);
   /*******************************************************************/
   /*                                                                 */
   /*   reason codes                                                  */
   /*                                                                 */
   /*******************************************************************/

   dcl uex_Reason_Output               fixed bin(15) value(0);
   dcl uex_Reason_Suppress             fixed bin(15) value(1);

   dcl header  pointer;

   dcl
     1 message_item native based,
       2 message_Info,
         3 facid     char(3),
         3 msgno     fixed bin(31),
         3 newsev    fixed bin(15),
         3 reason    fixed bin(31),
         3 variable  char(31) var,
       2 link pointer;

 ibmuexit: proc ( ue, ia ) options( fetchable );

   dcl 1 ue like uex_Uib byaddr;
   dcl 1 ia like uex_Isa byaddr;

   dcl sysuexit     file stream input env(recsize(80));
   dcl next         pointer;
   dcl based_Chars  char(8) based;
   dcl title_Str    char(8) var;
   dcl eof          bit(1);


   on error
     begin;
       on error system;
       call plidump('TFBHS' );
     end;

   on undefinedfile(sysuexit)
     begin;
       put edit ('** User exit unable to open exit file ')
                (A) skip;
       put skip;
       signal error;
     end;
	 
   if ue.uex_Uib_User_Char_Len = 0 then
     do;
       open file(sysuexit);
     end;
   else
     do;
       title_Str
        = substr( ue.uex_Uib_User_Char_Str->based_Chars,
                  1, ue.uex_Uib_User_Char_Len );
       open file(sysuexit) title(title_Str);
     end;
   /***************************************************************/
   /*                                                             */
   /*  save the address of the message filter so that it will     */
   /*  be invoked by the compiler                                 */
   /*                                                             */
   /***************************************************************/

   ue.Uex_UIB_Message_Filter = message_filter;
   
   /***************************************************************/
   /*                                                             */
   /*  set the pointer to the linked list to null                 */
   /*                                                             */
   /*  then allocate the first message record                     */
   /*                                                             */
   /***************************************************************/

   header = sysnull();
   allocate message_item set(next);

   /******************************************************************/
   /*                                                                */
   /*  skip header lines and read the file                           */
   /*                                                                */
   /*  the file is expected to start with a header line and          */
   /*  then a line with a scale and then the data lines, for example,*/
   /*  it could look like the 5 lines below starting with "Fac Id"   */
   /*                                                                */  
   /*   Fac Id   Msg No   Severity   Suppress   Insert               */
   /* +-------+-------+---------+---------+------------------------  */
   /*   'IBM'     3259        0          1      'DSNH527'            */
   /*   'IBM'     3024        0          1      'DSNH4760'           */
   /*   'IBM'     3024        0          1      'DSNH050'            */
   /*                                                                */
   /******************************************************************/

   eof = '0'b;
   on endfile(sysuexit)
     eof = '1'b;

   get file(sysuexit) list(next->message_info) skip(3);

   do while( eof = '0'b );
   
     /*************************************************************/
     /*                                                           */
     /*  put message information in linked list                   */
     /*                                                           */
     /*************************************************************/

     next->link = header;
     header = next;
	 
     /*************************************************************/
     /*                                                           */
     /*  read next data line                                      */
     /*                                                           */
     /*************************************************************/

     allocate message_item set(next);
     get file(sysuexit) skip;
     get file(sysuexit) list(next->message_info);

   end;
   /***************************************************************/
   /*                                                             */
   /*  free the last message record allocated and close the file  */
   /*                                                             */
   /***************************************************************/

   free next->message_Item;
   close file(sysuexit);

 end;

 message_Filter: proc ( ue, mf  );

   dcl 1 ue like uex_Uib byaddr;
   dcl 1 mf like uex_Mfx byaddr;

   dcl next         pointer;
   dcl jx           fixed bin(31);
   dcl insert       char(256) var;
   dcl based_Chars  char(256) based;

   on error
     begin;
       on error system;
       call plidump('TFBHS' );
     end;
	 
   /***************************************************************/
   /*                                                             */
   /*  by default, leave the reason code etc unchanged            */
   /*                                                             */
   /***************************************************************/

   ue.uex_Uib_Reason_Code = uex_Reason_Output;
   ue.uex_Uib_Return_Code = 0;

   mf.uex_Mfx_New_Severity = mf.uex_Mfx_Severity;
   
   /***************************************************************/
   /*                                                             */
   /*  save the first insert if it has character type             */
   /*                                                             */
   /***************************************************************/

   insert = '*';
   if mf.Uex_MFX_Length < stg(mf) then;
   else
     if mf.Uex_MFX_Inserts = 0 then;
     else
       do jx = 1 to mf.Uex_MFX_Inserts;
         select( mf.Uex_MFX_Ins_Type(jx) );
           when( uex_Ins_Type_Char )
             do;
               if jx = 1 then
                 insert =
                   substr( mf.Uex_MFX_Ins_Str_Addr(jx)->based_Chars,
                           1,mf.Uex_MFX_Ins_Str_Len(jx));
             end;
           otherwise;
         end;
       end;
	   
   /***************************************************************/
   /*                                                             */
   /*  search list for matching error message                     */
   /*                                                             */
   /***************************************************************/

   search_list:
   do next = header repeat( next->link ) while( next !=sysnull() );

     if next->msgno = mf.uex_Mfx_Message_No
      & next->facid = mf.Uex_Mfx_Facility_Id then
       do;
         if next->variable = '*' then
           leave search_list;
         if next->variable
          = substr(insert,1,length(next->variable)) then
           leave search_list;
       end;
   end;

   /***************************************************************/
   /*                                                             */
   /*  if list exhausted, then                                    */
   /*    no match was found                                       */
   /*  else                                                       */
   /*    filter the message according to the match found          */
   /*                                                             */
   /***************************************************************/

   if next = sysnull() then;
   else
     do;
       /***********************************************************/
       /*                                                         */
       /*  filter error based on information in table             */
       /*                                                         */
       /***********************************************************/

       ue.uex_Uib_Reason_Code = next->reason;
       if next->newsev < 0 then;
       else
         mf.uex_Mfx_New_Severity = next->newsev;
     end;
 end;

 exitterm: proc ( ue, ta  );

   dcl 1 ue like uex_Uib byaddr;
   dcl 1 ta like uex_Tsa byaddr;

   ue.uex_Uib_return_Code = 0;
   ue.uex_Uib_reason_Code = 0;

 end;

 end;

Terms of use | Feedback

This information center is powered by Eclipse technology. (http://www.eclipse.org)