/*
 * Removal of this header is illegal.
 * Written by Scott Auge scott_auge@yahoo.com sauge@amduus.com
 * Copyright (c) 2002 Amduus Information Works, Inc.  www.amduus.com
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. All advertising materials mentioning features or use of this software
 *    must display the following acknowledgement:
 *      This product includes software developed by Amduus Information Works
 *      Inc. and its contributors.
 * 4. Neither the name of Amduus Information Works, Inc. nor the names of 
 *    its contributors may be used to endorse or promote products derived 
 *    from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY AMDUUS AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AMDUUS OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 *
 */

DEF VAR RCSVersion AS CHARACTER INIT "$Header: /home/appl/Denkh/src/rptgen/RCS/PrgSub.p,v 3.2 2003/07/10 20:25:28 sauge Exp sauge $" NO-UNDO. 

/* Find @prg() macros, run the named program with the given inputs, replace */
/* macro with program output.                                               */

DEF INPUT PARAMETER cS AS CHARACTER NO-UNDO.
DEF OUTPUT PARAMETER cT AS CHARACTER NO-UNDO.

/* Go through the input looking for @prg()'s, take out the program, take */
/* out the input for the program, run the program, replace the whole     */
/* thing with the program's output. */

DEF VAR cB         AS CHARACTER NO-UNDO.
DEF VAR cSub       AS CHARACTER NO-UNDO.
DEF VAR cPrg       AS CHARACTER NO-UNDO.
DEF VAR cPrgArg    AS CHARACTER NO-UNDO.
DEF VAR cPrgOutPut AS CHARACTER NO-UNDO.
DEF VAR i          AS INTEGER NO-UNDO.
DEF VAR cC         AS CHARACTER NO-UNDO.
DEF VAR cCurChar   AS CHARACTER NO-UNDO.
DEF VAR iCurPos    AS INTEGER NO-UNDO.
DEF VAR iParanCnt  AS INTEGER NO-UNDO.
 
ASSIGN cT = cS.
  
REPEAT:
      
    /* If there is no holder, then leave */
     
   IF INDEX (cT, "@prg(") = 0 THEN LEAVE.
     
   /* We found one - chop out the arguments and go run things */
   /* It is the right one, pull out the contents between  */
   /* the ( and ) characters.  The first argument is the  */
   /* Program name to run, the second is the input to the */
   /* program name.  Note the input should always be a    */
   /* string.                                             */
   /* Fix: The argument to the program may be a string    */
   /* that contains a ( and a ).  This will screw things  */
   /* up fierce, so account for the paranthesis that      */
   /* might be present.  We assume they are matching!     */

   /* Find out where in the incoming string the @prg( is */

   ASSIGN iCurPos = INDEX (cT, "@prg(") + 5.

   /* Save up after that portion - it should include the string to */
   /* to format, as well the closing paranthesis (and other stuff  */
   /* in the record.  We want to use this later on to perform a    */
   /* REPLACE.                                                     */

   ASSIGN cB = SUBSTRING (cT, iCurPos).
    
/* disp cB. */

   /* We need to find the closing paranthesis to the @fmt(.  This is  */
   /* kinda tricky, cuz we might have a set of paranthesis as part of */
   /* the string to format.  We do this by counting the number of (   */
   /* we encounter, incrementing iParanCnt.  When we meet a closing ) */
   /* we decrement iParanCnt.  If we meet a ) and iParanCnt = 0, it   */
   /* should be the closing paranthesis for @prg(.                    */
 
   ASSIGN cC = "".
   DO iCurPos = 1 TO LENGTH(cB):
/* disp cC. */
     ASSIGN cCurChar = SUBSTRING(cB, iCurPos, 1).
/* disp cCurChar. */
     IF cCurChar = "(" THEN ASSIGN iParanCnt = iParanCnt + 1.

     IF cCurChar = ")" THEN DO:
       IF iParanCnt > 0 THEN iParanCnt = iParanCnt - 1.
       ELSE LEAVE.
     END.

     ASSIGN cC = cC + cCurChar.

   END.  /* DO iCurPos = 1 TO LENGTH(cB) */

   /* Remember the string so we can do a big REPLACE on it */

   ASSIGN cB = cC.

   /* Remember the string so we can do a big REPLACE on it */

   ASSIGN cSub = "@prg(" + cB + ")".

   /* Program is the first argument */
 
   cPrg = ENTRY(1, cB).

   /* Arguments to the program is the second argument */
   /* Fix: If the argument is a string, it may contain a , which */
   /* will confuse things with ENTRY().  Be sure to pull in all  */
   /* entries 2 + n to get the whole string.                     */

   IF NUM-ENTRIES(cB) > 1 THEN DO: 
     ASSIGN cPrgArg = "".
     DO i = 2 TO NUM-ENTRIES(cB):
       ASSIGN cPrgArg = cPrgArg + ENTRY(i, cB) + ",".
     END.
     ASSIGN cPrgArg = SUBSTRING(cPrgArg, 1, LENGTH(cPrgArg) - 1).
   END.

/* MESSAGE  cPrgArg. */

   /* Go run the program and retrieve it's output */

   RUN VALUE(cPrg) (INPUT cPrgArg, OUTPUT cPrgOutPut). 

   /* Go do a big search and replace on the the prg */
   /* with it's output.                             */

   cT = REPLACE (cT, cSub, cPrgOutPut).

END. /* REPEAT: */