/* ************************************************************************** */
/* EXCSQL: Execute SQL request                                                */
/* Copyright (C) 2001  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(&REQUEST &OUTPUT &QUALSRTSEQ &PRTF &OUTFILE &OUTMBR)
  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(825)
  DCL        VAR(&REQUEST2) TYPE(*CHAR) LEN(830)
  DCL        VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
  DCL        VAR(&FILEATR) TYPE(*CHAR) LEN(3)
  DCL        VAR(&OUTPUT) TYPE(*CHAR) LEN(1)
  DCL        VAR(&QUALSRTSEQ) TYPE(*CHAR) LEN(20)
  DCL        VAR(&SRTSEQ) TYPE(*CHAR) LEN(10)
  DCL        VAR(&SRTSEQLIB) TYPE(*CHAR) LEN(10)
  DCL        VAR(&JOBSRTSEQ) TYPE(*CHAR) LEN(10)
  DCL        VAR(&JOBSRTSEQL) TYPE(*CHAR) LEN(10)
  DCL        VAR(&PRTF) TYPE(*CHAR) LEN(20)
  DCL        VAR(&PRTFNAME) TYPE(*CHAR) LEN(10)
  DCL        VAR(&PRTFLIB) TYPE(*CHAR) LEN(10)
  DCL        VAR(&OUTFILE) TYPE(*CHAR) LEN(20)
  DCL        VAR(&OUTFILENAM) TYPE(*CHAR) LEN(10)
  DCL        VAR(&OUTFILELIB) TYPE(*CHAR) LEN(10)
  DCL        VAR(&OUTMBR) TYPE(*CHAR) LEN(20)
  DCL        VAR(&OUTMBRNAME) TYPE(*CHAR) LEN(10)
  DCL        VAR(&OUTMBROPT) TYPE(*CHAR) LEN(8)
  DCL        VAR(&ORGFILENAM) TYPE(*CHAR) LEN(10)
  DCL        VAR(&ORGFILELIB) TYPE(*CHAR) LEN(10)
  DCL        VAR(&ORGMBROPT) TYPE(*CHAR) LEN(8)
  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(&SQL7) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQL8) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQL9) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQLA) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQLB) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQLC) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQLD) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQLE) TYPE(*CHAR) LEN(55)
  DCL        VAR(&SQLF) TYPE(*CHAR) LEN(55)
/* ************************************************************************** */
/*  GLOBAL MESSAGE MONITOR                                                    */
/* ************************************************************************** */
  MONMSG     MSGID(CPF0000 RPG0000 QRG0000 RSF0000 +
               MCH0000) EXEC(GOTO CMDLBL(##ERROR))
  GOTO       CMDLBL(##NOERROR)
##ERROR:
  SNDPGMMSG  MSGID(CPF9899) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
##NOERROR:
/* ************************************************************************** */
/*  START OF MAINLINE CODE                                                    */
/* ************************************************************************** */
  CHGVAR     VAR(&SRTSEQ) VALUE(%SST(&QUALSRTSEQ 1 10))
  CHGVAR     VAR(&SRTSEQLIB) VALUE(%SST(&QUALSRTSEQ 11 10))
  CHGVAR     VAR(&PRTFNAME) VALUE(%SST(&PRTF 1 10))
  CHGVAR     VAR(&PRTFLIB) VALUE(%SST(&PRTF 11 10))
  CHGVAR     VAR(&OUTFILENAM) VALUE(%SST(&OUTFILE 1 10))
  CHGVAR     VAR(&OUTFILELIB) VALUE(%SST(&OUTFILE 11 10))
  CHGVAR     VAR(&OUTMBRNAME) VALUE(%SST(&OUTMBR 3 10))
  CHGVAR     VAR(&OUTMBROPT) VALUE(%SST(&OUTMBR 13 8))
  CHGVAR     VAR(&ORGFILENAM) VALUE(%SST(&OUTFILE 1 10))
  CHGVAR     VAR(&ORGFILELIB) VALUE(%SST(&OUTFILE 11 10))
  CHGVAR     VAR(&ORGMBROPT) VALUE(%SST(&OUTMBR 13 8))
/* If a different sort sequence specified, switch to it now */
  IF         COND(&SRTSEQ *NE '*SAME') THEN(DO)
/* Get current sort sequence, so it can be restored afterwards (if needed) */
    RTVJOBA    SRTSEQ(&JOBSRTSEQ) SRTSEQLIB(&JOBSRTSEQL)
    IF         COND(&SRTSEQLIB *NE '          ') THEN(DO)
      CHGJOB     SRTSEQ(&SRTSEQLIB/&SRTSEQ)
      MONMSG     MSGID(CPF1651) EXEC(GOTO CMDLBL(ERRORS2))
    ENDDO
    ELSE       CMD(DO)
      CHGJOB     SRTSEQ(&SRTSEQ)
      MONMSG     MSGID(CPF1651) EXEC(GOTO CMDLBL(ERRORS2))
    ENDDO
  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 >= 825) 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(825 - &POS1)
    CHGVAR     VAR(&REMAIN2) VALUE(825 - &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 55))
  CHGVAR     VAR(&SQL7) VALUE(%SST(&REQUEST2 331 55))
  CHGVAR     VAR(&SQL8) VALUE(%SST(&REQUEST2 386 55))
  CHGVAR     VAR(&SQL9) VALUE(%SST(&REQUEST2 441 55))
  CHGVAR     VAR(&SQLA) VALUE(%SST(&REQUEST2 496 55))
  CHGVAR     VAR(&SQLB) VALUE(%SST(&REQUEST2 551 55))
  CHGVAR     VAR(&SQLC) VALUE(%SST(&REQUEST2 606 55))
  CHGVAR     VAR(&SQLD) VALUE(%SST(&REQUEST2 661 55))
  CHGVAR     VAR(&SQLE) VALUE(%SST(&REQUEST2 716 55))
  CHGVAR     VAR(&SQLF) VALUE(%SST(&REQUEST2 771 55))
/* Execute the request */
/* Echo output to display */
  IF         COND(&OUTPUT *EQ '1') THEN(DO)
    STRQMQRY   QMQRY(EXCSQL) OUTPUT(*) ALWQRYDFN(*YES) +
                 SETVAR((SQL1 &SQL1) (SQL2 &SQL2) (SQL3 +
                 &SQL3) (SQL4 &SQL4) (SQL5 &SQL5) (SQL6 +
                 &SQL6) (SQL7 &SQL7) (SQL8 &SQL8) (SQL9 +
                 &SQL9) (SQLA &SQLA) (SQLB &SQLB) (SQLC +
                 &SQLC) (SQLD &SQLD) (SQLE &SQLE) (SQLF +
                 &SQLF))
    MONMSG     MSGID(QWM2701) EXEC(GOTO CMDLBL(ERRORS1))
  ENDDO
/* Echo output to print */
  IF         COND(&OUTPUT *EQ '2') THEN(DO)
/* Substitute default printfile if required */
    IF         COND(&PRTFNAME *EQ '*EXCSQL') THEN(CHGVAR +
                 VAR(&PRTFNAME) VALUE('EXCSQL'))
/* Substitute default *LIBL if required */
    IF         COND(&PRTFLIB *EQ ' ') THEN(CHGVAR +
                 VAR(&PRTFLIB) VALUE('*LIBL'))
/* Use chosen report for output */
    OVRPRTF    FILE(QPQXPRTF) TOFILE(&PRTFLIB/&PRTFNAME)
    STRQMQRY   QMQRY(EXCSQL) OUTPUT(*PRINT) ALWQRYDFN(*YES) +
                 SETVAR((SQL1 &SQL1) (SQL2 &SQL2) (SQL3 +
                 &SQL3) (SQL4 &SQL4) (SQL5 &SQL5) (SQL6 +
                 &SQL6) (SQL7 &SQL7) (SQL8 &SQL8) (SQL9 +
                 &SQL9) (SQLA &SQLA) (SQLB &SQLB) (SQLC +
                 &SQLC) (SQLD &SQLD) (SQLE &SQLE) (SQLF +
                 &SQLF))
    MONMSG     MSGID(QWM2701) EXEC(GOTO CMDLBL(ERRORS1))
  ENDDO
/* Echo output to database file */
  IF         COND(&OUTPUT *EQ '3') THEN(DO)
/* If *UPDADD requested, then divert *outfile data to temporary file first, */
/* then copy it to requested file - STRQMQRY doesn't support the *UPDADD */
/* option that CPYF does */
    IF         COND(&OUTMBROPT *EQ '*UPDADD') THEN(DO)
      RTVMBRD    FILE(&OUTFILELIB/&OUTFILENAM) +
                          RTNLIB(&RTNLIB) FILEATR(&FILEATR)
      IF         COND(&FILEATR *EQ '*PF') THEN(DO)
        DLTF       FILE(QTEMP/EXCSQLTEMP)
        MONMSG     MSGID(CPF2105)
        CRTDUPOBJ  OBJ(&OUTFILENAM) FROMLIB(&RTNLIB) +
                     OBJTYPE(*FILE) TOLIB(QTEMP) +
                     NEWOBJ(EXCSQLTEMP)
        CHGVAR     VAR(&OUTFILENAM) VALUE('EXCSQLTEMP')
        CHGVAR     VAR(&OUTFILELIB) VALUE('QTEMP')
        CHGVAR     VAR(&OUTMBROPT) VALUE('*ADD')
      ENDDO
    ENDDO
    STRQMQRY   QMQRY(EXCSQL) OUTPUT(*OUTFILE) +
                 OUTFILE(&OUTFILELIB/&OUTFILENAM) +
                 OUTMBR(&OUTMBRNAME &OUTMBROPT) +
                 ALWQRYDFN(*YES) SETVAR((SQL1 &SQL1) (SQL2 +
                 &SQL2) (SQL3 &SQL3) (SQL4 &SQL4) (SQL5 +
                 &SQL5) (SQL6 &SQL6) (SQL7 &SQL7) (SQL8 +
                 &SQL8) (SQL9 &SQL9) (SQLA &SQLA) (SQLB +
                 &SQLB) (SQLC &SQLC) (SQLD &SQLD) (SQLE +
                 &SQLE) (SQLF &SQLF))
    MONMSG     MSGID(QWM2701) EXEC(GOTO CMDLBL(ERRORS1))
    IF         COND(&ORGMBROPT *EQ '*UPDADD') THEN(DO)
      CPYF       FROMFILE(QTEMP/EXCSQLTEMP) +
                   TOFILE(&ORGFILELIB/&ORGFILENAM) +
                   FROMMBR(&OUTMBRNAME) TOMBR(&OUTMBRNAME) +
                   MBROPT(*UPDADD) FROMRCD(1) FMTOPT(*MAP +
                   *DROP) ERRLVL(*NOMAX)
    MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRORS1))
    ENDDO
  ENDDO
  GOTO       CMDLBL(ENDPGM)
ERRORS1:
/* If the job's sort sequence was changed, switch back to the original values */
  IF         COND(&JOBSRTSEQ *NE '          ') THEN(DO)
    IF         COND(&JOBSRTSEQL *NE '          ') THEN(DO)
      CHGJOB     SRTSEQ(&JOBSRTSEQL/&JOBSRTSEQ)
    ENDDO
    ELSE       CMD(DO)
      CHGJOB     SRTSEQ(&JOBSRTSEQ)
    ENDDO
  ENDDO
  SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('EXCSQL +
               encountered one or more problems in the +
               SQL - review joblog.') MSGTYPE(*ESCAPE)
ERRORS2:
  SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('EXCSQL +
               could not switch to the requested sort +
               sequence. Review joblog.') MSGTYPE(*ESCAPE)
ENDPGM:
/* If the job's sort sequence was changed, switch back to the original values */
  IF         COND(&JOBSRTSEQ *NE '          ') THEN(DO)
    IF         COND(&JOBSRTSEQL *NE '          ') THEN(DO)
      CHGJOB     SRTSEQ(&JOBSRTSEQL/&JOBSRTSEQ)
    ENDDO
    ELSE       CMD(DO)
      CHGJOB     SRTSEQ(&JOBSRTSEQ)
    ENDDO
  ENDDO
  DLTOVR     FILE(QPQXPRTF)
  MONMSG     MSGID(CPF9841)
  RETURN
ENDPGM