<verbatim> /* ************************************************************************** */ /* DBG102CL: Execute database generation scripts */ /* Copyright (C) 2000 Martin Rowe <martin@dbg400.net> */ /* */ /* This program is free software; you can redistribute it and/or modify */ /* it under the terms of the GNU General Public License as published by */ /* the Free Software Foundation; either version 2 of the License, or */ /* (at your option) any later version. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU General Public License for more details. */ /* */ /* You should have received a copy of the GNU General Public License */ /* along with this program; if not, write to the Free Software */ /* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* ************************************************************************** */ PGM PARM(&LIBRARY &TARGET &SOURCE &REQUEST &MBROPT &RQSTYPE) DCL VAR(&LIBRARY) TYPE(*CHAR) LEN(10) DCL VAR(&MBROPT) TYPE(*CHAR) LEN(8) DCL VAR(&POS1) TYPE(*DEC) LEN(3 0) DCL VAR(&POS2) TYPE(*DEC) LEN(3 0) DCL VAR(&POS3) TYPE(*DEC) LEN(3 0) DCL VAR(&REMAIN1) TYPE(*DEC) LEN(3 0) DCL VAR(&REMAIN2) TYPE(*DEC) LEN(3 0) DCL VAR(&REQUEST) TYPE(*CHAR) LEN(300) DCL VAR(&REQUEST2) TYPE(*CHAR) LEN(305) DCL VAR(&RQSTYPE) TYPE(*CHAR) LEN(7) DCL VAR(&SOURCE) TYPE(*CHAR) LEN(10) DCL VAR(&SQL1) TYPE(*CHAR) LEN(55) DCL VAR(&SQL2) TYPE(*CHAR) LEN(55) DCL VAR(&SQL3) TYPE(*CHAR) LEN(55) DCL VAR(&SQL4) TYPE(*CHAR) LEN(55) DCL VAR(&SQL5) TYPE(*CHAR) LEN(55) DCL VAR(&SQL6) TYPE(*CHAR) LEN(55) DCL VAR(&TARGET) TYPE(*CHAR) LEN(10) /* ************************************************************************** */ /* START OF MAINLINE CODE */ /* ************************************************************************** */ /* Point the source/control file in the target library, rather than the one */ /* in the library list - unless this is a plain SQL request, not a link type */ IF COND(&RQSTYPE *EQ '*LINK') THEN(DO) OVRDBF FILE(&SOURCE) TOFILE(&LIBRARY/&SOURCE) ENDDO IF COND((&RQSTYPE *EQ '*SQLUPD') *OR (&RQSTYPE + *EQ '*SQLDLT')) THEN(DO) OVRDBF FILE(&TARGET) TOFILE(&LIBRARY/&TARGET) ENDDO /* QMQRY variables truncate trailing blanks, so if the end of each variable */ /* is blank, then a leading blank should be inserted into the next variable. */ CHGVAR VAR(&POS1) VALUE(55) CHGVAR VAR(&REQUEST2) VALUE(&REQUEST) TOPOFLOOP: /* Drop out of loop once the full SQL string has been processed */ IF COND(&POS1 > 300) THEN(GOTO CMDLBL(NEXTSTEP)) IF COND(%SST(&REQUEST2 &POS1 1) *EQ ' ') THEN(DO) CHGVAR VAR(&POS2) VALUE(&POS1 + 1) CHGVAR VAR(&POS3) VALUE(&POS2 + 1) CHGVAR VAR(&REMAIN1) VALUE(300 - &POS1) CHGVAR VAR(&REMAIN2) VALUE(300 - &POS2) CHGVAR VAR(%SST(&REQUEST2 &POS3 &REMAIN2)) + VALUE(%SST(&REQUEST2 &POS2 &REMAIN1)) CHGVAR VAR(%SST(&REQUEST2 &POS2 1)) VALUE(' ') ENDDO CHGVAR VAR(&POS1) VALUE(&POS1 + 55) GOTO CMDLBL(TOPOFLOOP) NEXTSTEP: /* Break up the SQL request into 55 character long chunks */ CHGVAR VAR(&SQL1) VALUE(%SST(&REQUEST2 1 55)) CHGVAR VAR(&SQL2) VALUE(%SST(&REQUEST2 56 55)) CHGVAR VAR(&SQL3) VALUE(%SST(&REQUEST2 111 55)) CHGVAR VAR(&SQL4) VALUE(%SST(&REQUEST2 166 55)) CHGVAR VAR(&SQL5) VALUE(%SST(&REQUEST2 221 55)) CHGVAR VAR(&SQL6) VALUE(%SST(&REQUEST2 276 30)) /* Execute the request (No outfile for SQL UPDATE or DELETE requests) */ IF COND((&RQSTYPE *EQ '*SQLUPD') *OR (&RQSTYPE + *EQ '*SQLDLT')) THEN(DO) STRQMQRY QMQRY(DBG102QM) ALWQRYDFN(*YES) SETVAR((SQL1 + &SQL1) (SQL2 &SQL2) (SQL3 &SQL3) (SQL4 + &SQL4) (SQL5 &SQL5) (SQL6 &SQL6)) ENDDO ELSE CMD(DO) STRQMQRY QMQRY(DBG102QM) OUTPUT(*OUTFILE) + OUTFILE(&LIBRARY/&TARGET) OUTMBR(*FIRST + &MBROPT) ALWQRYDFN(*YES) SETVAR((SQL1 + &SQL1) (SQL2 &SQL2) (SQL3 &SQL3) (SQL4 + &SQL4) (SQL5 &SQL5) (SQL6 &SQL6)) ENDDO IF COND(&RQSTYPE *EQ '*LINK') THEN(DO) DLTOVR FILE(&SOURCE) ENDDO IF COND((&RQSTYPE *EQ '*SQLUPD') *OR (&RQSTYPE + *EQ '*SQLDLT')) THEN(DO) DLTOVR FILE(&TARGET) ENDDO ENDPGM: RETURN ENDPGM </verbatim> -- Main.MartinRowe - 24 Jun 2005
This topic: DBG400
>
SourceCodeList
>
ClSource
>
ClDBG102CL
Topic revision: r1 - 24 Jun 2005 - 04:56:58 -
MartinRowe
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400?
Send feedback