/* +
 RPLSST:    Replace a substring with a supplied replacement substring.         +
                                                                               +
            This is a specialized module for the 'Process List' functions. It  +
            isn't intended to be used anywhere else. The incoming string and   +
            the substring to search for and replacement substring are defined  +
            with lengths that are appropriate in these functions.              +
                                                                               +
            with lengths that are appropriate in these functions.              +
*/

 pgm   ( +
         &pCmd        +
         &pCmdLen     +
         &pRpl        +
         &pSst        +
       )


   dcl   &pCmd        *char  6000
   dcl   &pCmdLen     *dec  (   5 0 )
   dcl   &pRpl        *char     3
   dcl   &pSst        *char    10


   dcl   &WrkCmd      *char  6000
   dcl   &PrcCmd      *char  6000

   dcl   &RplLen      *dec  (   3 0 )
   dcl   &pt1Len      *dec  (   3 0 )
   dcl   &pt2Len      *dec  (   5 0 )
   dcl   &pt2Str      *dec  (   5 0 )

   dcl   &RplLoc      *dec  (   3 0 )

   dcl   &PrcCmdLen   *dec  (   5 0 )
   dcl   &ScanLen     *dec  (   3 0 )
   dcl   &StrPos      *dec  (   3 0 ) value( 1 )
   dcl   &wrkLen      *dec  (   5 0 )

   dcl   &CStkCtr         *char      4
   dcl   &CStkIDLen       *char      4
   dcl   &RSNM0100        *char     29


/*                                                           */
/* Global message monitor...                                 */
/*                                                           */

   monmsg    ( cpf0000 cpf9999 ) exec( goto Std_Err )


   chgvar      &WrkCmd                  &pCmd

   Qsys/rtvmsg  CPF9897  msgf( QSYS/QCPFMSG )  +
                  msgdta( &pRpl )  +
                  msglen( &WrkLen )

   chgvar      &RplLen                  &WrkLen


/*                                                                  */
/*  Search/replace -- substitution substrings are replaced...       */
/*                                                                  */

Nxt_Rpl:

/*  Maximum scan length is 999...                                   */

   if ( &pCmdLen *gt 999 )  +
      chgvar    &ScanLen              ( 999 )
   else  +
      chgvar    &ScanLen                &pCmdLen


/*  Maximum start position is 5002...                               */
/*    (...because that's where the 999 scan limit starts...)        */

   if ( &StrPos *gt 5002 )  +
      chgvar    &StrPos               ( 5002 )


/*  Scan for a replacement substring...                             */

   CLSCAN     STRING( &WrkCmd ) STRLEN( &ScanLen ) STRPOS( &StrPos ) +
                PATTERN( &pRpl ) RESULT( &RplLoc ) PATLEN( &RplLen )


/*  If replacement location was found by scan...                    */

   if ( &RplLoc *gt 0 )  do

/*  If replacement location was found by scan...                    */
/*     &pt1Len  length of string before substitution substring...   */
/*     &pt2Str  start of string after substitution substring...     */
/*     &pt2Len  length of string after substitution substring...    */
/*                                                                  */
/*                &RplLen                                           */
/*                 v-vv------------&pt2Len---------------------.    */
/*     &pt1Len----v   v----&pt2Str                             v    */
/*     xxxxxxxxxxxx@@Rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx    */
/*     ^           ^---&RplLoc                                 ^    */
/*     '---------------&ScanLen--------------------------------'    */

      chgvar   &pt1Len                ( &RplLoc - 1 )
      chgvar   &pt2Str                ( &RplLoc + &RplLen )
      chgvar   &pt2Len                ( &ScanLen - &pt2Str + 1 )

/*  In case remaining substring is null, grab a trailing blank...   */
/*    Note that this effectively limits &pCmd to *char(5999)...     */
      if ( &pt2Len *eq 0 )  +
         chgvar &pt2Len               ( 1 )

/*  Find length of replacement value...                             */
      RTNLEN     VALUE( &pSst ) LEN( &wrkLen )

/*  Length of replacement value replaces length of substitution...  */
      chgvar   &PrcCmdLen             ( &pt1Len + &wrkLen + &pt2Len )

/*  Set new string to the three substrings...                       */
      chgvar   &PrcCmd          ( +
                                  %sst( &WrkCmd 1 &pt1Len ) *cat  +
                                        &pSst               *tcat +
                                  %sst( &WrkCmd &pt2Str &pt2Len ) +
                                )

/*  Next StrPos is set to position just after replacement...        */
      chgvar   &StrPos                ( &RplLoc + &wrkLen )

   /*                                                               */
   /*  If we changed it, reset it for the next scan loop...         */
   /*                                                               */
      chgvar   &WrkCmd                  &PrcCmd

      RTNLEN     VALUE( &WrkCmd ) LEN( &pCmdLen )


   /*                                                               */
   /*  In case of multiple occurrences...                           */
   /*                                                               */
      goto  Nxt_Rpl

   enddo


   /*  In case we changed it, reset it before returning...          */

   chgvar      &pCmd                    &WrkCmd

   return


Std_Err:

   /* Move any *DIAG messages up the stack...        */

   Qsys/call  pgm( QSYS/QMHMOVPM ) parm( +
                                         '    '          +
                                         '*DIAG     '    +
                                         x'00000001'     +
                                         '*         '    +
                                         x'00000001'     +
                                         x'00000000'     +
                                       )
   Qsys/monmsg     ( CPF0000 MCH0000 )

   /* Resend any *ESCAPE messages up the stack...     */

   chgvar    %bin( &CStkCtr   )        2
   Qsys/monmsg     ( CPF0000 MCH0000 )
   chgvar    %bin( &CStkIDLen )        1
   Qsys/monmsg     ( CPF0000 MCH0000 )

   chgvar    &RSNM0100               ( &CStkCtr     *CAT +
                                       '*NONE     *NONE     ' *CAT +
                                       &CStkIDLen   *CAT +
                                       '*'               +
                                     )
   Qsys/monmsg     ( CPF0000 MCH0000 )


   Qsys/call  pgm( QSYS/QMHRSNEM ) parm( +
                                         '    '          +
                                         x'00000000'     +
                                         &RSNM0100       +
                                         x'0000001D'     +
                                         'RSNM0100 '     +
                                         '*               ' +
                                         x'00000000'     +
                                       )
   Qsys/monmsg     ( CPF0000 MCH0000 )

   return

endpgm