× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: Re: regex in rpg
  • From: Scott Klement <klemscot@xxxxxxxxxxxx>
  • Date: Thu, 3 May 2001 18:23:18 -0500 (CDT)



On Wed, 2 May 2001, Hatzenbeler, Tim wrote:

> Is there a way to bind in the regex functions in rpg?  Similar to the way
> you would use the other c functions?
[SNIP]
> p.s.  if it can be done... samples would be really appreciated :-)

Okay...  I converted the example from the "ILE C for AS/400 Runtime
reference" into RPG (more or less)    The difference being that I used
diagnostic messages and escape messages instead of printf-type messages.

Here's the example...  hope it helps:

     H BNDDIR('QC2LE') DFTACTGRP(*NO)

     D regex_t         DS                  align
     D  re_nsub                      10I 0
     D  re_comp                        *
     D  re_cflags                    10I 0
     D  re_erroff                    10I 0
     D  re_len                       10I 0
     D  re_ucoll                     10I 0 dim(2)
     D  re_lsub                        *   DIM(9)
     D  re_esub                        *   DIM(9)
     D  re_map                      256A
     D  re_shift                      5I 0
     D  re_dbcs                       5I 0

     D regmatch_t      DS                  occurs(2) align
     D  rm_so                        10I 0
     D  rm_ss                         5I 0
     D  rm_eo                        10I 0
     D  rm_es                         5I 0

     D regcomp         PR            10I 0 extproc('regcomp')
     D   preg                          *   value
     D   pattern                       *   value
     D   cflags                      10I 0 value

     D regexec         PR            10I 0 extproc('regexec')
     D   preg                          *   value
     D   string                        *   value
     D   nmatch                      10U 0 value
     d   pmatch                        *   value
     D   eflags                      10I 0 value

     D regerror        PR            10U 0 extproc('regerror')
     D   errcode                     10I 0 value
     D   preg                          *   value
     D   errbuf                        *   value
     D   errbuf_size                 10I 0 value

     D regfree         PR                  extproc('regfree')
     D   preg                          *   value

     D DiagMsg         PR
     D   peMsgTxt                   256A   Const

     D EscapeMsg       PR
     D   peMsgTxt                   256A   Const

     D preg            S               *
     D pmatch          S               *
     D string          S             50A
     D len             S             10I 0
     D rc              S             10I 0
     D nmatch          S             10U 0 INZ(2)
     D Msg             S             50A
     D Buf             S            256A
     D pattern         S             50A

     c                   eval      *inlr = *on

     c* Set example values
     c                   eval      string = 'a very simple simple ' +
     c                                      'simple string' + x'00'
     c                   eval      pattern = '\(sim[a-z]le\) \1' + x'00'

     c* Initialize pointers
     c     1             occur     regmatch_t
     c                   eval      preg = %addr(regex_t)
     c                   eval      pmatch = %addr(regmatch_t)

     C* Compile RE
     c                   eval      rc=regcomp(preg:%addr(pattern):0)
     c                   if        rc <> 0
     c                   callp     regerror(rc: preg: %addr(buf): 256)
     c                   callp     EscapeMsg('regcomp() failed with: ' +
     c                               %str(%addr(buf)))
     c                   endif

     C* Execute RE
     c                   eval      rc = regexec(preg: %addr(string):
     c                                nmatch: pmatch: 0)
     c                   if        rc <> 0
     c                   callp     regerror(rc: preg: %addr(buf): 256)
     c                   callp     regfree(preg)
     c                   callp     EscapeMsg('regexec() failed with: ' +
     c                                %str(%addr(buf)))
     c                   endif

     C* Show results:
     c     1             occur     regmatch_t
     c                   eval      len = rm_eo - rm_so
     c                   eval      rm_so = rm_so + 1
     c                   callp     DiagMsg('With the whole expression, ' +
     c                                'a matched substring "' +
     c                                 %subst(string: rm_so: len) +
     c                                '" is found at position ' +
     c                                 %trim( %editc(rm_so: 'Z') ) +
     c                                ' to ' + %trim( %editc(rm_eo: 'Z') ))

     c     2             occur     regmatch_t
     c                   eval      len = rm_eo - rm_so
     c                   eval      rm_so = rm_so + 1
     c                   callp     DiagMsg('With the sub-expression, ' +
     c                                'a matched substring "' +
     c                                 %subst(string: rm_so: len) +
     c                                '" is found at position ' +
     c                                 %trim( %editc(rm_so: 'Z') ) +
     c                                ' to ' + %trim( %editc(rm_eo: 'Z') ))


     c                   callp     regfree(preg)
     c                   return


     P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P*  This puts a diagnostic message into the job log
     P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P DiagMsg         B
     D DiagMsg         PI
     D   peMsgTxt                   256A   Const

     D SndPgmMsg       PR                  ExtPgm('QMHSNDPM')
     D   MessageID                    7A   Const
     D   QualMsgF                    20A   Const
     D   MsgData                    256A   Const
     D   MsgDtaLen                   10I 0 Const
     D   MsgType                     10A   Const
     D   CallStkEnt                  10A   Const
     D   CallStkCnt                  10I 0 Const
     D   MessageKey                   4A
     D   ErrorCode                    1A

     D dsEC            DS
     D  dsECBytesP             1      4I 0 inz(256)
     D  dsECBytesA             5      8I 0 inz(0)
     D  dsECMsgID              9     15
     D  dsECReserv            16     16
     D  dsECMsgDta            17    256

     D wkMsgLen        S             10I 0
     D wkTheKey        S              4A

     c     ' '           checkr    peMsgTxt      wkMsgLen
     c                   if        wkMsgLen<1
     c                   return
     c                   endif

     c                   callp     SndPgmMsg('CPF9897': 'QCPFMSG   *LIBL':
     c                               peMsgTxt: wkMsgLen: '*DIAG':
     c                               '*': 0: wkTheKey: dsEC)

     c                   return
     P                 E


     P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P*  This ends the program with an escape message
     P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P EscapeMsg       B
     D EscapeMsg       PI
     D   peMsgTxt                   256A   Const

     D SndPgmMsg       PR                  ExtPgm('QMHSNDPM')
     D   MessageID                    7A   Const
     D   QualMsgF                    20A   Const
     D   MsgData                    256A   Const
     D   MsgDtaLen                   10I 0 Const
     D   MsgType                     10A   Const
     D   CallStkEnt                  10A   Const
     D   CallStkCnt                  10I 0 Const
     D   MessageKey                   4A
     D   ErrorCode                    1A

     D dsEC            DS
     D  dsECBytesP             1      4I 0 inz(256)
     D  dsECBytesA             5      8I 0 inz(0)
     D  dsECMsgID              9     15
     D  dsECReserv            16     16
     D  dsECMsgDta            17    256

     D wkMsgLen        S             10I 0
     D wkTheKey        S              4A

     c     ' '           checkr    peMsgTxt      wkMsgLen
     c                   if        wkMsgLen<1
     c                   return
     c                   endif

     c                   callp     SndPgmMsg('CPF9898': 'QCPFMSG   *LIBL':
     c                               peMsgTxt: wkMsgLen: '*ESCAPE':
     c                               '*PGMBDY': 1: wkTheKey: dsEC)

     c                   return
     P                 E

+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...

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.