|
midrange.com
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 mailing list archive is Copyright 1997-2025 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.
