zOs/PLB/QZPLB
*process default(connected);
QZPLB: proc($parm) options(main);
/*_____________________________________________________________________
declarationS */
%include pgmanfa; /* On Error */
dcl $parm char(80) varying;
/* printer file */
dcl sysprint file print;
/* sqlca struc */
exec sql include sqlca;
/* db cursor (dynamic sql) sql */
exec sql declare c1 cursor for s1;
/* counters decl */
dcl 1 cnt
, 5 cnt bin fixed(31) init(0)
, 5 sel bin fixed(31) init(0)
, 5 ins bin fixed(31) init(0)
, 5 write_ddout bin fixed(31) init(0)
, 5 errors bin fixed(31) init(0)
, 5 commit_counter bin fixed(31) init(0)
, 5 tst char(26) init('')
, 5 fun char(126) varying init('')
;
/* builtins decl */
dcl (addr, binary, length, pliRetv,trim, string) builtin;
/*_____________________________________________________________________
main */
/* inits */
put ('start of qzPlb') skip;
put (' parm ', length($parm), ':', $parm, '|') skip;
call testBit(' 12abc');
return;
call sql_connect();
put ('connected') skip;
if substr($parm, 1, 1) = 'A' then
call doA(substr($parm, 2, 1));
else if substr($parm, 1, 1) = 'B' then
call doB;
else do;
put (' no test ') skip;
cnt.tst = '';
cnt.sel = 123;
cnt.tst = 'sel = ' || edit(sel, '9999') || ' und schluss';
put (' sel=123: ', cnt.tst) skip;
exec sql
select current timestamp into :cnt.tst
from sysibm.sysDummy1
;
put ('sql code: ', sqlCode) skip;
if sqlCode <> 0 THEN
call sqlMsg;
put ('selected current timestamp: ', cnt.tst) skip;
end;
RETURN;
/*_____________________________________________________________________
subroutines */
doA:proc($f);
dcl $f char(1);
dcl (ix, jx) bin fixed(31) init(0);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
do jx=1 to 5;
do ix=1 to 10000;
pa = edit(1 + mod(ix, 5), '999');
uu = 'uuid' || edit(ix, '9999') || '=uuid';
fo = 'for';
tx = copy('p=' || pa || ' uuid=' || uu || ' fo=' || fo
|| '... ', 40);
if $f = '1' then
call doV1(pa, uu, fo, tx);
else if $f = '2' then
call doV2(pa, uu, fo, tx);
else if $f = '3' then
call doV3(pa, uu, fo, tx);
end;
end;
call sql_commit;
put ('commit after ' || trim(edit(cnt.cnt, 'zzzzzz9'))
|| ' ' || $f || ': ' || cnt.fun) skip;
end doA;
doV1: proc(pa, uu, fo, tx);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
DCL seq BIN(31) INIT(-1);
/* put ('V1 ' || pa || ' u=' || uu || ' fo=' || fo) skip */
exec sql
select value(max(XC502_DOC_CONTENT_SEQ)+1, 1)
into :seq
from qtxCry.tQBXC5a1 where XC502_PART_NUMBER = :pa
and XC502_doc_uuid = :uu and XC502_doc_format = :fo
;
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'select value ...');
/* put ('seq ' || trim(edit(seq, 'zzzzz9'))
|| ' ' || substr(tx, 1, 60)) skip */
exec sql
insert into qtxCry.tQBXC5a1
values(:pa, :uu, :fo, :seq, :tx)
;
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'insert values ...');
cnt.cnt = cnt.cnt + 1;
cnt.fun = 'select & insert';
end doV1;
doV2: proc(pa, uu, fo, tx);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
/* put ('V2 ' || pa || ' u=' || uu || ' fo=' || fo) skip */
exec sql
insert into qtxCry.tQBXC5a1
select :pa, :uu, :fo
, value(max(XC502_DOC_CONTENT_SEQ)+1, 1)
, :tx
from qtxCry.tQBXC5a1 where XC502_PART_NUMBER = :pa
and XC502_doc_uuid = :uu and XC502_doc_format = :fo
;
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'insert ... select');
cnt.cnt = cnt.cnt + 1;
cnt.fun = 'insert from select';
end doV2;
doV3: proc(pa, uu, fo, tx);
dcl (pa, fo)char(3);
dcl uu char(36);
dcl tx char(10000) varying;
DCL seq BIN(31) INIT(-1);
/* put ('V3 ' || pa || ' u=' || uu || ' fo=' || fo) skip */
exec sql
select XC502_DOC_CONTENT_SEQ into :seq
from final table
(
insert into qtxCry.tQBXC5a1
select :pa, :uu, :fo
, value(max(XC502_DOC_CONTENT_SEQ)+1, 1)
, :tx
from qtxCry.tQBXC5a1 where XC502_PART_NUMBER = :pa
and XC502_doc_uuid = :uu and XC502_doc_format = :fo
) ;
/* put ('got seq', seq) skip */
if sqlCode <> 0 then
call sqlErr(sourceLine(), 'select ... insert ... select');
cnt.cnt = cnt.cnt + 1;
cnt.fun = 'select from insert from select';
end doV3;
doB:proc();
end doB;
/*
sql connect__________________________________________________________*/
%include yxrrsaf;
sql_connect:proc();
dcl ssid char(04) init('DP4G');
dcl plan char(08) init('QZTEST');
if yxrrsaf('CONNECT',ssid,plan) ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Call'
,'SSID - '||ssid
,'PLAN - '||plan);
end sql_connect;
/*
commit_______________________________________________________________*/
sql_commit: proc();
if yxrrsaf('COMMIT') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF Commit Call');
end sql_commit;
sql_rollback: proc();
if yxrrsaf('ROLLBACK') ^= 0 then
put('QZPLB'
,'Error in YXRRSAF ROLLBACK Call');
end sql_rollback;
DCL DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE);
sqlMsg: proc ();
DCL MSGWIDTH FIXED BIN(31) INIT(72);
DCL MSGBLEN FIXED BIN(15) INIT(20); /* MAX # SQL MESSAGES */
DCL i FIXED BIN(31) INIT(0);
DCL 01 MESSAGE /* MESSAGE RETURN BUFFER */
, 02 MESSAGEL FIXED BIN(15) INIT(1440) /* BUFFER LENGTH */
, 02 MESSAGET(MSGBLEN) CHAR(msgWidth) INIT((*)' ') /* TEXT */
;
/* NOW PRINT OUT SQL STATEMENT RESULTS VIA DSNTIAR */
CALL DSNTIAR(SQLCA,MESSAGE,MSGWIDTH);
IF PLIRETV ^= 0 THEN DO; /* IF THE RETURN CODE ISN'T ZERO@08*/
/* ISSUE AN ERROR MESSAGE @08*/
PUT EDIT (' RETURN CODE ', PLIRETV, /* @08*/
' FROM MESSAGE ROUTINE DSNTIAR.') /* @08*/
(COL(1), A(13), F(8), A(30)); /* ISSUE THE MESSAGE @08*/
END; /* END ISSUE AN ERROR MESSAGE @08*/
DO I = 1 TO MSGBLEN /* @08*/
WHILE (MESSAGET(I) ^= ''); /* @08*/
PUT EDIT ( MESSAGET(I) ) (COL(1), A(msgWIdth)); /* @08*/
END; /* @08*/
end SqlMsg;
sqlErr: proc (lNo, txt);
DCL lNo FIXED BIN(31);
dcl txt char(500) varying;
put ('error at ' || trim(edit(lNo, 'ZZZZZZZZZ9'))
|| ': ' || txt) skip;
call sqlMsg;
call sql_rollback;
put ('error signal error') skip;
signal error;
end sqlErr;
testBit: proc(i);
dcl i char(6);
dcl p pointer;
dcl b1 bit(1) dimension (48) based (p);
dcl b8 fixed binary (8) unsigned dim ( 6) based (p);
dcl b6 bit (6) unaligned dim ( 8) based (p);
dcl b bit(6) dimension ( 8) based (p);
DCL x FIXED BIN(31) INIT(0);
put ('testBit i = ' || i) skip;
p = addr(i);
do x=1 to 48;
put ('b1 ', x , ' => ' , b1(x)) skip;
end;
do x=1 to 6;
put ('b8 ', x , ' => ' , b8(x)) skip;
end;
do x=1 to 8;
put edit('b6', x , ' => ', b6(x), ' bin ', binary(b6(x)))
(a(4), f(5) , a(4), b(6), a(4), f(5)) skip;
end;
end testBit;
end QZPLB;