/* ************************************************************************** */
/* 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
--
MartinRowe - 24 Jun 2005