zOs/REXX/UT

/* copy ut begin  ****************************************************/
utIni: procedure expose m.
    if m.ut_ini == 1 then
        return
    m.ut_ini = 1
    m.ut_Num    = '0123456789'
                /* 012345678901234567890123456789 */
    m.ut_lc     = 'abcdefghijklmnopqrstuvwxyz'
    m.ut_uc     = translate(m.ut_lc)
    m.ut_uc25   = left(m.ut_uc, 25)
    m.ut_alfa   = m.ut_lc || m.ut_uc
    m.ut_alfNum = m.ut_alfa || m.ut_Num
    m.ut_alfDot = m.ut_alfNum || '.'
    m.ut_alfId  = m.ut_alfNum'_' /* avoid rexx allowed @ # $ ¬ . | ? */
    m.ut_alfIdN1 = m.ut_Num       /* not as first character */
    m.ut_rxId   = m.ut_AlfNum'@#$?' /* charset puff mit ¬*/
    m.ut_rxDot  = '.'m.ut_rxId
    m.ut_rxN1   = '.0123456789'
    m.ut_space  = '05'x' '         /* with space: space and Tab char */
    m.ut_alfPrint = m.ut_alfNum'+-*/=()[]{}<> .:,;?|''"%&#@$£\_'
    m.ut_numUc = m.ut_num || m.ut_uc
    m.ut_base64 = m.ut_uc || m.ut_lc || m.ut_Num'+-'
    m.ut_alfLC  = m.ut_lc   /* backward compatibility */
    m.ut_alfUC  = m.ut_uc   /* backward compatibility */
    return
endProcedure utIni
/*--- if function  warning all3 arguments get evaluated|
                   e.g if(x=0, 'infinity', 1/0) will fail| ----------*/
if: procedure expose m.
parse arg co, ifTrue, ifFalse
    if co then
        return ifTrue
    else
        return ifFalse
endProcedure if

/*--- strip and returnn first argument not space --------------------*/
firstNS: procedure expose m.
    do ax=1 to arg()
        if arg(ax) <> '' then
            return strip(arg(ax))
        end
    return ''
endProcedure firstNS

/*--- return current time and cpu usage -----------------------------*/
utTime: procedure expose m.
    return time() 'ela='time('E') 'cpu='sysvar('syscpu'),
            'su='sysvar('syssrv')

/*--- sleep several seconds -----------------------------------------*/
sleep: procedure expose m.
parse arg secs, sayIt
    if sayit <> 0 then
        say time() 'sleeping' secs 'secs'
    CALL SYSCALLS 'ON'
    ADDRESS SYSCALL "sleep" secs
    CALL SYSCALLS 'OFF'
    if sayit <> 0 then
        say time() 'slept' secs 'secs'
    return
endProcedure sleep

/*--- left without truncation ---------------------------------------*/
lefPad: procedure expose m
parse arg s, len
    if length(strip(s, 't')) >= len then
        return strip(s, 't')
    return left(s, len)
endProcedure lefPad

/*--- right without truncation --------------------------------------*/
rigPad: procedure expose m
parse arg s, len
    if length(strip(s, 'l')) >= len then
        return strip(s, 'l')
    return right(s, len)
endProcedure rigPad

/*--- quote string txt using quoteChar qu ("" ==> ") ----------------*/
quote: procedure expose m.
parse arg txt, qu
    if qu = '' then
        qu = '"'
    res = qu
    ix = 1
    do forever
        qx = pos(qu, txt, ix)
        if qx = 0 then
            return res || substr(txt, ix) || qu
        res = res || substr(txt, ix, qx-ix) || qu || qu
        ix = qx + length(qu)
        end
endProcedure quote

/*--- translate to lowercase ----------------------------------------*/
ut2lc: procedure expose m.
parse arg s
    return translate(s, m.ut_lc, m.ut_uc)

/*--- verify an id --------------------------------------------------*/
verifId: procedure expose m.
    parse arg src, extra
    if pos(left(src, 1), m.ut_alfIdN1) > 0 then
        return 1
    else
        return verify(src, m.ut_alfId || extra, 'n')

/*--- return the count of occurrences of needle in heyStack ---------*/
posCount: procedure expose m.
parse arg needle, hayStack, start, fin
    if start = '' then
        start = 1
    if fin = '' then
        fin = length(hayStack) + 1 - length(needle)
    do cnt = 0 by 1
        start = pos(needle, haystack, start)
        if start < 1 | start > fin then
             return cnt
        start = start + length(needle)
        end
endProcedure posCount

repAll: procedure expose m.
parse arg src
    do ax = 2 by 2 to arg()
        src = repAl2(src, src, arg(ax), arg(ax+1))
        end
    return src
endProcedure repAll

repAl2: procedure expose m.
parse arg src, sPos, old, new
    res = ''
    cx = 1
    do forever
        nx = pos(old, sPos, cx)
        if nx < 1 then
            return res || substr(src, cx)
        res = res || substr(src, cx, nx-cx) || new
        cx = nx + length(old)
        end
endProcedure repAl2

repAllWords: procedure expose m.
parse arg src, w, new
    res = ''
    wx = 0
    cx = 1
    do forever
        wx = wordPos(w, src, wx+1)
        if wx < 1 then
            return res || substr(src, cx)
        nx = wordindex(src, wx)
        res = res || substr(src, cx, nx-cx) || new
        cx = nx + length(w)
        end
endProcedure repAllWords
/*--- character to decimal '0140'x --> 256+64=320 -------------------*/
utc2d: procedure expose m.
parse arg ch
    cx = length(ch) // 3
    if cx = 0 then
        cx = 3
    res = c2d(left(ch, cx))
    do cx=cx+1 by 3 to length(ch)
        res = res * 16777216 + c2d(substr(ch, cx, 3))
        end
    return res
endProcedure utc2d

utInter: procedure expose m.
    interpret arg(1)
    return
endProcedure utInter
/* copy ut end *******************************************************/