/*---------Language: REXX-------------------------------------$$PROLOG*/
/*     Program Name: LOADRULE.CMD                                     */
/*      Description: Reload the current Automation Point rules        */
/*    Customization: None                                             */
/* Input Parameters: PAUSE      Wait before exit so msgs can be seen  */
/*                   DEBUG      Standard debugging parm.              */
/*                   filename   New rules file to activate  (default  */
/*                              is to refresh from the existing file).*/
/*    Statvars Used: AP_ACTIVE_RULES (read only)                      */
/*       Invocation: Launched from USER.MNU via following menu item   */
/*            ITEM  =  ('~Reload Rules File', XCCMD(REXX "LOADRULE")),*/
/*                   Or launched from cmd line via:                   */
/*                     ASOREXX LOADRULE newrules.rul PAUSE            */
/*          Invokes: None                                             */
/*     Return Codes: 0  - Successful Completion.   12 - It crashed.   */
/* Related Routines:                                                  */
/*     Base Release: CA-Automation Point 3.2 or higher, OS/2 or NT.   */
/*     Restrictions: None                                             */
/*     Dependencies: None                                             */
/*       Change log: Add new entries to the top                       */
/*-----------------Changed 11-NOV-1998 by: Bob Stark -----------------*/
/* 1. Initial coding                                                  */
/*--------------------------------------------------------------------*/
/* Copyright (C) 1999 ProTech Professional Technical Services. No war-*/
/* ranty expressed or implied. Permission to use, copy, and distribute*/
/* this document without fee is hereby granted, provided that this    */
/* copyright notice appear in all copies.  Permission to modify the   */
/* code is granted, but not the right to distribute the modified code,*/
/* which should be returned to the maintainer for inclusion into the  */
/* distributed version.  Contacts: 412-373-8855  www.protechpts.com   */
/*--------------------------------------------------------------------*/

CALL   ON ERROR   NAME RXERROR
SIGNAL ON SYNTAX  NAME RXERROR
SIGNAL ON NOVALUE NAME RXERROR
TRACE N

debug = ''
pause = ''
parms = TRANSLATE(ARG(1))

n = WORDPOS('PAUSE', parms)    /* Extract PAUSE keycode, if specified */
IF n > 0 THEN
  DO
  parms = DELWORD(parms,n,1)
  pause = 'PAUSE'
  END

n = WORDPOS('DEBUG', parms)    /* Extract DEBUG keycode, if specified */
IF n > 0 THEN
  DO
  parms = DELWORD(parms,n,1)
  debug = 'DEBUG'
  TRACE I
  END

IF parms <> ''                     /* If any parms are left,          */
THEN rulefile = parms              /* Then it is the rules filename   */
ELSE
  DO
  /* Get filename of currently active rules                           */
  ADDRESS AXC 'GETVAR AP_ACTIVE_RULES rulefile'
  IF rc <> 0
  THEN CALL ERRMSGX 'Aborting... unable to determine current rules'
  END

ADDRESS AXC "LOADRULES FILE("rulefile") REPLACE(CLEAN)"
IF WORDPOS(rc,'0') = 0
THEN CALL ERRMSGX "Loadrule failed, rc = "rc
ELSE
  DO
  SAY 'LOADRULE Completed successfully, rc='rc
  END

EXIT:
IF SYMBOL('pause') <> 'LIT' THEN
  IF pause <> '' THEN
    DO
    SAY 'Press any key to exit...'
    PULL .
    END
IF SYMBOL('max_rc') = 'LIT'
THEN max_rc = 0
EXIT max_rc

/*--------------------------------------------------------------------*/
/* RXCOPY routines follow (in alphabetical order)                     */
/*--------------------------------------------------------------------*/

/*RXCOPY ERRMSGX **** 22 LINES COPIED ON 07-13-99 AT 05:22*************/
/*-Start of ERRMSGX function----------------------------Version-01.02-*/
/*:ERRMSGX SUBROUTINE: Issues a formatted error message and exits.    */
/* Parameters: Message text                                           */
/* DOES NOT RETURN!                                                   */
/* For example:                                                       */
/* IF missing <> ''                                                   */
/* then call ERRMSGX('Missing required parameter(s):'missing)         */
/* Copyright (C) 1996 Washington Systems. All rights reserved.        */
/*--------------------------------------------------------------------*/
ERRMSGX:
TRACE N
PARSE ARG _errmsgx_text
PARSE SOURCE . . _errmsgx_filename .
_errmsgx_errtext = 'REXX Error: '_errmsgx_filename' '_errmsgx_text
SAY _errmsgx_errtext
IF ADDRESS() = 'AXC' THEN
  DO
  ADDRESS AXC "WTXC '"_errmsgx_errtext"'"
  ADDRESS AXC "WTO '"_errmsgx_errtext"'"
  END
SIGNAL EXIT
/*-End of ERRMSGX  function-------------------------------------------*/

/*RXCOPY RXERROR **** 122 LINES COPIED ON 07-13-99 AT 05:22************/
/*START OF RXERROR--------------------------------------Version-01.05-*/
/*:RXERROR SUBROUTINE: Generic REXX error condition handler. This     */
/* routine gets control when a condition is raised, and:              */
/* a. Validates that the condition is ok, and returns quietly, or     */
/* b. Issues diagnostic messages about the error & where it occured.  */
/*                                                                    */
/* To use this routine, code the following near the top of your exec: */
/* CALL   ON ERROR   NAME RXERROR                                     */
/* SIGNAL ON SYNTAX  NAME RXERROR                                     */
/* SIGNAL ON NOVALUE NAME RXERROR                                     */
/*                                                                    */
/* In addition, set the variable 'ok' to any return code values       */
/* that are acceptable for host commands.  For example:               */
/*                                                                    */
/* ok=4; ADDRESS TSO 'GETVARL GLOBAL_*'; DROP ok                      */
/* ok='4 8';"host cmd"; DROP ok <-- return codes 4 or 8 are ok        */
/* ok='all';"host cmd"; DROP ok <-- all return codes are acceptable   */
/*                                                                    */
/* The first example permits GETVARL to get rc 4 and not fail or      */
/* issue any error messages.  Note that "ok=0" is always implied      */
/* because the REXX ERROR condition is not raised if rc=0.            */
/*------------------------------------------------------------------- */
/*NOTES: This subroutine does not use the PROCEDURE instruction, so   */
/*       variable names used within it must be _hidden.               */
/*                                                                    */
/*       If an error occurs that's not one of the 'OK' values,        */
/*       execution will fall thru this subroutine and any statements  */
/*       following it will be executed.  This is a good place to put  */
/*       cleanup logic, or a signal to your "cleanup-and-exit" label. */
/*                                                                    */
/*       As a side effect, RXERROR sets ISPF "CONTROL ERRORS RETURN". */
/*       If your routine doesn't run this way, you'll need to restore */
/*       your ISPF CONTROL ERRORS setting.                            */
/* Copyright (C) 1996,1998 Washington Systems. All rights reserved.   */
/*--------------------------------------------------------------------*/

RXERROR:
TRACE N                           /* Turn off tracing for this func.  */
_sigl = sigl
CALL   OFF ERROR
SIGNAL OFF SYNTAX
IF SYMBOL('rc') = 'VAR' THEN _rc = rc
ELSE _rc = 'n/a'
PARSE SOURCE _EX_ENV . _EX_NAME . . . . _EX_ADDRSPC .
IF POS(CONDITION('C'),'ERROR FAILURE') > 0 THEN  /* Error or Failure? */
                                       /* Yes. Were we CALLed?        */
  IF CONDITION('I') = 'CALL' | _EX_ENV = 'OPS/REXX' THEN
    IF SYMBOL('OK') = 'VAR' THEN       /* Yes.  Is OK a variable?     */
      IF WORDPOS(_rc,ok)>0 | TRANSLATE(ok)='ALL' THEN /* Is error ok? */
        DO                                            /* Yes, return  */
        CALL   ON ERROR   NAME RXERROR /*  Restore the                */
        SIGNAL ON SYNTAX  NAME RXERROR /*   Error handler             */
        DROP ZERRLM                    /* Toss any ISPF error msg     */
        rc = _rc                       /* Restore orig RC for caller  */
        RETURN                         /* Return to point of error    */
        END
_errtext = '';                     /* Initialize error text           */
IF CONDITION('C') = 'SYNTAX' THEN  /* If a REXX syntax error,         */
  IF _rc >= 0 & _rc < 100          /*  and rc is within valid range,  */
  THEN _errtext = ' ('ERRORTEXT(_rc)')';/* then get REXX error text.  */
  ELSE NOP;
ELSE
  IF CONDITION('C') = 'NOVALUE' THEN /* See if undefined variable     */
    DO;
    _errtext = ' (No value for variable 'CONDITION('D')')';
    _rc = 'n/a';                   /* RC not set for NOVALUE          */
    END
  ELSE
    IF POS(CONDITION('C'),'ERROR FAILURE') > 0 THEN /*Hostcmd problem?*/
      DO   /* Extract host cmd name... */
      _cmd = STRIP(STRIP(WORD(CONDITION('D'),1),'B','"'),'B',"'")
      _errtext = ' (Host command '_cmd')'
      _addr = ADDRESS()            /* Find environment of failing cmd */
      IF _sigl <= SOURCELINE() THEN/* Is source code avail?           */
        IF TRANSLATE(WORD(SOURCELINE(_sigl),1)) = 'ADDRESS'
        THEN _addr = TRANSLATE(WORD(SOURCELINE(_sigl),2))
      _addr = STRIP(TRANSLATE(_addr,,'!@#$%&*()_-+=;:,./?"'"'",' '))
      IF _addr = 'PPQ' & SYMBOL('PPQ.ERROR') = 'VAR'
      THEN _errtext = ' (Host command PPQ, 'ppq.error')'
      IF _addr = 'VOX' & SYMBOL('VOX.ERROR') = 'VAR'
      THEN _errtext = ' (Host command VOX, 'vox.error')'
      IF _addr = 'ASODDE' | SYMBOL('ASODDE.ERROR') = 'VAR'
      THEN _errtext = ' (Host command ASODDE, 'asodde.error')'
      IF SYMBOL('SQLCODE') = 'VAR'
      THEN _errtext = ' ( SQLCODE=' sqlcode')'
      END
    ELSE
      _errtext = ' (Condition='CONDITION('C')', Description=',
        CONDITION('D')')'

IF _ex_addrspc = 'ISPF' THEN       /* Running under ISPF?             */
  DO                               /* Yes, issue short & long msgs... */
  ADDRESS ISPEXEC "CONTROL ERRORS RETURN" /* Capture all ISPF RCs     */
  zedsmsg = ''                     /* Format ISPF short message       */
  zedlmsg = "Error RC "_rc""_errtext" at line "_sigl" in EXEC" _EX_NAME
  IF _sigl <= SOURCELINE()         /* Is source code avail?           */
  THEN zedlmsg = LEFT(zedlmsg': ',78)STRIP(SOURCELINE(_sigl))
  IF SYMBOL('ZERRLM') = 'VAR'
  THEN zedlmsg = LEFT(zedlmsg,156) 'ISPF Error: 'STRIP(ZERRLM)
  ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
  IF rc = 12 THEN                  /* ISPMLIB MESSAGE found?          */
    DO                             /* No, use SAY instead.            */
    SAY 'RXERROR ISPMLIB Message ISRZ001 Not Found'
    SIGNAL _SAY_ERRMSG;
    END
  SIGNAL _SAY_SQLMSG;
  END

_SAY_ERRMSG:
SAY "RXERROR Error RC "_rc""_errtext" at line "_sigl,
    "in EXEC "_ex_name
IF _sigl <= SOURCELINE()          /* Is source code avail?           */
THEN SAY "RXERROR Source Line "_sigl": "STRIP(SOURCELINE(_sigl))
SAY ''
_SAY_SQLMSG:
IF SYMBOL('SQLCODE') = 'VAR' & QUEUED() > 0 THEN
  IF WORDPOS(sqlcode,'0 100') = 0 THEN
    DO _i = 1 BY 1 WHILE QUEUED() > 0
    PULL _stack
    SAY 'SQL STACK:'RIGHT(_i,2)':'_stack
    END
/*END OF RXERROR------------------------------------------------------*/
max_rc = 12
SIGNAL EXIT