/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Program ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? x ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Version: ?1.00 ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Date: ? ? yyyy-mm-dd ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Purpose: ?x ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? x ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? x ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Setup: ? ?x ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Revision: x ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? x ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
?
call TIME 'R' ? ? ? ? ? ? ? ? ? ?/* reset elapsed timer - sssss.uuuuu */
parse arg ?I_CommandLine
?
numeric digits 15
call !!Initialization
?
/*------------------------*\
| ?Enable trap processing ?|
\*------------------------*/
? ?SIGNAL ON ERROR
/* ? SIGNAL ON FAILURE*/
? ?SIGNAL ON HALT
? ?SIGNAL ON NOVALUE
? ?SIGNAL ON SYNTAX
?
/*
select
? when GBL.parameter.0 = 0 then do
? ? nop
? ? end
? when GBL.parameter.0 = 1 ? ? ? ? ? ? ? ?& ,
? ? ? (GBL.parameter.1 = '-?' ? ? ? ? ? ? | ,
? ? ? ?GBL.parameter.1 = '/?' ? ? ? ? ? ? | ,
? ? ? ?GBL.parameter.1 = '?' ? ? ? ? ? ? ?| ,
? ? ? ?translate(GBL.parameter.1) = '-H' ?| ,
? ? ? ?translate(GBL.parameter.1) = '/H') then do
? ? call !!Command_Syntax
? ? call !!EOJ 60012
? ? end
? otherwise do
? ? nop
? ? end
? end
?
!tr!=VALUE('REXXTRACE',, GBL.Environment); if !tr!<>'' then do;say 'Trace' !tr! 'started'; TRACE(!tr!);nop;end
?
*/
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Main section of code ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
/* >>>>>>>>>>>>>>>>>>>>> Insert your main code here <<<<<<<<<<<<<<<<<<<<< */
?
rc = SysSleep(10)
?
call !!EOJ 0
?
/* >>>>>>>>>>>>>>>>>>>> Insert your subroutines here <<<<<<<<<<<<<<<<<<<< */
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Subroutine section ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
?
?
?
/* >>>>>>>>>>>>>>>>>>>>>>>> End non-template code <<<<<<<<<<<<<<<<<<<<<<< */
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?NOTE: ?Modify this section as necessary to display your command syntax. |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!Command_Syntax: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Purpose: ?Provide the command syntax ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? None. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!Command_Syntax: procedure expose ,
? ?(GBL.List)
?
Command_Syntax.1 ?= ''
Command_Syntax.2 ?= ''
Command_Syntax.3 ?= ''
Command_Syntax.4 ?= ''
Command_Syntax.5 ?= ''
Command_Syntax.6 ?= ''
Command_Syntax.7 ?= ''
Command_Syntax.8 ?= ''
Command_Syntax.9 ?= ''
Command_Syntax.10 = ''
Command_Syntax.0 = 10
?
do CS = 1 to Command_Syntax.0
? call !!Say_Directed 3,'i',Command_Syntax.CS
? end
?
return
?
/* >>>>>>>>>>>>>>>>>>>>> Begin template/common code <<<<<<<<<<<<<<<<<<<<< */
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!Initialization ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Purpose: ?Initialize variables before starting the main code section.|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!Initialization:
GBL. ? ? ? ? ? ?= '' ? ? ? ? ? ? ? ?/* initialize stem */
GBL.DumpExclusionList = '_bksp _cr _crlf _esc _ff _fs _lf _tab'
GBL.List ? ? ? ? ? ? ?= 'GBL.' GBL.DumpExclusionList
GBL.CommandLine ? ? ? = ?I_CommandLine
?
_bksp = '08'x
_cr ? = '0D'x
_crlf = '0D0A'x
_esc ?= '1B'x
_ff ? = '0C'x
_fs ? = D2C(127) /* ? */
_lf ? = '0A'x
_tab ?= '09'x
?
parse Version GBL.RexxVersion,
? ? ? ? ? ? ? GBL.RexxVersionLevel,
? ? ? ? ? ? ? GBL.RexxVersionDay,
? ? ? ? ? ? ? GBL.RexxVersionMonth,
? ? ? ? ? ? ? GBL.RexxVersionYear
parse Source ?GBL.OperatingSystem,
? ? ? ? ? ? ? GBL.CallingEnvironment,
? ? ? ? ? ? ? GBL.ProgramPathAndName
GBL.StartingDirectory = directory()
?
/*----------------------------------*\
| ?Determine platform & environment ?|
\*----------------------------------*/
GBL.DOS = 0; GBL.Win95 = 0; GBL.WinNT = 0; GBL.OS2 = 0
select
? ?when GBL.OperatingSystem ?= 'OS/2' then
? ? ? do
? ? ? ? ?GBL.Environment = 'OS2ENVIRONMENT'
? ? ? ? ?GBL.OS2 = 1
? ? ? ? ?parse upper value VALUE( 'PATH',, GBL.Environment ) with '\OS2\SYSTEM' -2,
? ? ? ? ? ? ? ? ? ? ? ? ? ?GBL.BootDrive ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?+2
? ? ? end
? ?when GBL.OperatingSystem ?= 'Windows95' then
? ? ? do
? ? ? ? ?GBL.Environment = 'ENVIRONMENT'
? ? ? ? ?GBL.Win95 = 1
? ? ? ? ?GBL.BootDrive ?= LEFT( VALUE( 'WINBOOTDIR',, GBL.Environment ), 2 )
? ? ? end
? ?when GBL.OperatingSystem ?= 'WindowsNT' then
? ? ? do
? ? ? ? ?GBL.Environment = 'ENVIRONMENT'
? ? ? ? ?GBL.WinNT = 1
? ? ? ? ?GBL.BootDrive ?= LEFT( VALUE( 'SYSTEMDRIVE',, GBL.Environment ), 2 )
? ? ? end
? ?when GBL.OperatingSystem ?= 'PCDOS' then
? ? ? do
? ? ? ? ?GBL.Environment = 'ENVIRONMENT'
? ? ? ? ?GBL.DOS = 1
? ? ? ? ?GBL.BootDrive ?= 'C:'
? ? ? end
? ?otherwise;
? ? ? do
? ? ? ? ?say 'Unable to determine environment'
? ? ? ? ?exit
? ? ? end
end
?
/*---------------*\
| ?Register APIs ?|
\*---------------*/
if GBL.DOS = 0 then
? ?do
? ? ? /* REXXUTIL - all but DOS */
? ? ? if RxFuncQuery( 'SysLoadFuncs' ) <> 0 then
? ? ? ? ?do
? ? ? ? ? ? call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
? ? ? ? ? ? call SysLoadFuncs
? ? ? ? ?end
?
? ? ? /* RXFTP - all but DOS */
? ? ? if RxFuncQuery( 'FTPLoadFuncs' ) <> 0 then
? ? ? ? ?do
/* ? ? ?call RxFuncAdd 'FTPLoadFuncs', 'rxFtp', 'FTPLoadFuncs' */
/* ? ? ? ? call FtpLoadFuncs ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? */
? ? ? ? ?end
?
? ? ? /* RXSOCK - all but DOS */
? ? ? if RxFuncQuery( 'SockLoadFuncs' ) <> 0 then
? ? ? ? ?do
? ? ? ? ? ? call RxFuncAdd 'SockLoadFuncs', 'rxsock', 'SockLoadFuncs'
? ? ? ? ? ? call SockLoadFuncs
? ? ? ? ?end
? ?end
?
if GBL.WinNT = 1 then
? ?do
? ? ? if RxFuncQuery('SQLLoadFuncs') <> 0 then
? ? ? ? ?do
/* ? ? ? ? ?call RxFuncAdd 'SQLLoadFuncs', 'rexxsql', 'SQLLoadFuncs'
? ? ? ? ? ? call SQLLoadFuncs
? ? ? ? ? ? say 'Rexx/SQL Version:' SQLVariable( 'version' ) */
? ? ? ? ?end
? ?end
?
if GBL.OS2 = 1 then
? ?do
? ? ? GBL.Warp ? ? ? ?= ( RxFuncQuery( 'SysMoveObject' ) = 0 )
? ? ? GBL.WarpPeer ? ?= ( SysIni( 'USER', 'PM_Workplace:Location', '<PEER_LOGOFF>' ) <> 'ERROR:' )
? ? ? GBL.WarpServer ?= ( SysIni( 'USER', 'PM_Workplace:Location', '<NSC_SERVER>' ) ?<> 'ERROR:' )
? ? ? GBL.Warp4 ? ? ? = ( SysIni( 'USER', 'PM_Workplace:Location', '<WP_HWMGR>' ) ? ?<> 'ERROR:' )
?
? ? ? /* REXXLIB - (c) Quercus Systems */
? ? ? if RxFuncQuery( 'rexxlibregister' ) <> 0 then
? ? ? ? ?do
? ? ? ? ? ? if GBL.RexxVersion ?= 'REXX/Personal' then dll_name = 'QREXXLIB'
? ? ? ? ? ? else ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? dll_name = 'REXXLIB'
? ? ? ? ? ? call RxFuncAdd 'REXXLibRegister', dll_name, 'rexxlibregister'
? ? ? ? ? ? call REXXLibRegister
? ? ? ? ?end
? ?end
?
parse value DATE('S') with year +4 mm +2 dd
GBL.CurrentDate ? ? ?= year || '/' || mm || '/' || dd
GBL.ErrorCount ? ? ? = 0
GBL.Hostname ? ? ? ? = VALUE( 'HOSTNAME',, GBL.Environment )
GBL.Ramdrive ? ? ? ? = VALUE( 'RAMDRIVE',, GBL.Environment )
GBL.ProgramBeginTime = TIME('L')
GBL.ProgramName ? ? ?= STRIP( FILESPEC( 'N', GBL.ProgramPathAndName ) )
GBL.ProgramPath ? ? ?= STRIP( FILESPEC( 'D', GBL.ProgramPathAndName ) ||,
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? FILESPEC( 'P', GBL.ProgramPathAndName ) )
GBL.ProgramVersion ? = 1.0 ? ? ? ? ?/* version / mod of this program */
GBL.TraceValue ? ? ? = TRANSLATE( VALUE( 'TRACE',, GBL.Environment ) )
?
/*------------------------------------*\
| ?Get program name in correct case & ?|
| ?program extension in upper case ? ? |
\*------------------------------------*/
dot_ptr = LASTPOS( '.', GBL.ProgramName ?)
parse value GBL.ProgramName ?with,
? ?GBL.ProgramFn,
? ?=(dot_ptr) +1,
? ?GBL.ProgramFe
GBL.ProgramFe ?= TRANSLATE( GBL.ProgramFe ?)
drop dd dot_ptr mm year
?
/*--------------------*\
| ?STDERR redirection ?|
\*--------------------*/
if GBL.RexxVersion = 'OBJREXX' ?& ?GBL.TraceValue = 'R' then
? ?do
? ? ? GBL.TraceFile = GBL.ProgramPath || GBL.ProgramFn || '.TRC'
? ? ? call SysFileDelete GBL.TraceFile
? ? ? .error~destination(.stream~new( GBL.TraceFile ) )
? ?end
?
/*--------------------------------------*\
| ?Define log file in program directory ?|
\*--------------------------------------*/
GBL.LogFile ?=,
? ?GBL.ProgramPath ?||,
? ?GBL.ProgramFn ? ?|| '.LOG'
/* call SysFileDelete GBL.LogFile */
if STREAM( GBL.LogFile, 'C', 'QUERY EXISTS' ) <> '' then
? ?do
? ? ? log_line = _crlf || COPIES( '=', 76 )
? ? ? call LINEOUT GBL.LogFile, log_line
? ?end
?
/*
log_line =,
? ?GBL.ProgramName,
? ?'Started on' DATE() 'at' TIME()
call LINEOUT GBL.LogFile, log_line
drop log_line
*/
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ?Customize how Say_Directed processes messages: ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?GBL.Say_Directed.Console: ? ?console | both | bothnc | file | filenc | ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? none ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ?GBL.Say_Directed.Timestamp: ?both ? ?| date | time ? | none ? ? ? ? ? ? |
| ?GBL.Say_Directed.Prefix: ? ? yes ? ? | none ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ?Set by default in this section.? You may customize, as necessary. ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?GBL.Say_Directed.FileName: ? ?Filename of log file. ? ? ? ? ? ? ? ? ? ? |
| ?GBL.Say_Directed.ModuleName: ?Module Name/Identifier ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? More details are in the Say_Directed subroutine documentation. ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
GBL.Say_Directed.Console ? ?= 'bothnc'
GBL.Say_Directed.TimeStamp ?= 'both'
GBL.Say_Directed.Prefix ? ? = 'yes'
?
GBL.Say_Directed.FileName ? = GBL.ProgramPath || ?GBL.programFN || '.Log'
GBL.Say_Directed.ModuleName = translate(GBL.programFN)
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Customize how DebugLog processes: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?GBL.DebugLog.Messages: ? both | dmp | log ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ?GBL.DebugLog.Variables: ?both | dmp | log ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ?GBL.DebugLog.Debug: ? ? ?yes / on / active | no / off / inactive ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ?Set by default in this section.? You may customize, as necessary. ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?GBL.DebugLog.FileName: ? Filename of debug dump file. ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? More details are in the DebugLog subroutine documentation. ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
GBL.DebugLog.Messages ?= 'both'
GBL.DebugLog.Variables = 'dmp'
GBL.DebugLog.Debug ? ? = 'yes'
GBL.DebugLog.FileName ?= GBL.ProgramPath || ?GBL.programFN || '.dmp'
?
GBL.DebugLog.LevelMessageOnly = 1
GBL.DebugLog.LevelDump ? ? ? ?= 2
GBL.DebugLog.LevelCMD ? ? ? ? = 3
GBL.DebugLog.LevelDumpCMD ? ? = 4
GBL.DebugLog.Debug ? ? ? ? ? ?= translate(GBL.DebugLog.Debug)
?
/*------------------------*\
| ?Place each command line |
| ?parameter into its own ?|
| ?variable ? ? ? ? ? ? ? ?|
\*------------------------*/
temp = GBL.CommandLine
do CL = 1 to 100000 while temp <> ''
? if substr(strip(temp),1,1) = '"' then
? ? parse var temp '"''"' temp
? ?else
? ? parse var temp temp
? end
GBL.parameter.0 = CL - 1
drop CL TEMP
?
GBL.Oracle_Connection.BaseDate = (date('b')-1)
GBL.Oracle_Connection.0 ? ? ? ?= 0
?
call !!Say_Directed 1,'i','Begin' GBL.ProgramName ?'at' TIME('N')
?
return
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!Password_Prompt: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Purpose: ?Prompt for password displaying only "*" for the ? ? ? ? ?|
| ? ? ? ? ? ? ? ? characters.? Support for backspace (x'08') given. ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? password = Password_Prompt <prompt> ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!Password_Prompt: procedure expose ,
? ? ?(GBL.List)
parse arg Password_Prompt
?
password = ''
call !!Say_Directed 1,'r',Password_Prompt
?
do forever
? key = SysGetKey('noecho')
? select
? ? when key = _cr then do
? ? ? if length(password) > 0 then leave
? ? ? password = ''
? ? ? end
? ? when key = _bksp then do
? ? ? if length(password) > 0 then do
? ? ? ? password = left(password,length(password) - 1)
? ? ? ? call charout ,_bksp
? ? ? ? call charout ,' '
? ? ? ? call charout ,_bksp
? ? ? ? end
? ? ? end
? ? when key = '03'x then do
? ? ? call !!Say_Directed 1,'t','Program Terminated.'
? ? ? call !!EOJ 60001
? ? ? end
? ? otherwise do
? ? ? call charout ,'*'
? ? ? password = password || key
? ? ? end
? ? end
? end
?
call charout ,_crlf
return password
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!Oracle_Connect: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Purpose: ?Connect to an Oracle username/SID and keep track of it ? |
| ? ? ? ? ? ? ? ? for debugging and ease of programming (e.g. disconnect ? |
| ? ? ? ? ? ? ? ? ALL). ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? This section and !!Oracle_Disconnect use the "array" ? ? |
| ? ? ? ? ? ? ? ? GBL.Oracle_Connection. to keep track of each Oracle ? ? ?|
| ? ? ? ? ? ? ? ? Connection. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Status. ? ?Denotes if the Oracle connection is active or inactive. ? |
| ? ? ? ? ? ? ? ?NOTE: ?If the DBA kills the Oracle or the database goes ? |
| ? ? ? ? ? ? ? ?down, this value does NOT change automatically. ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Username.? Oracle username used to connect to the SID. ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? SID. ? ? ? Oracle service name (as found in the TNSNAMES.ora file). ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? HTOD. ? ? ?Human readable time when the connection occurred. ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? MTOD. ? ? ?Machine readable time when the connection occurred, used ?|
| ? ? ? ? ? ? ? ?to denote the age of the connection. ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Comment. ? Programmer provided comment with which to track and/or ? ?|
| ? ? ? ? ? ? ? ?debug the connection. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? ConnectionID, Username, Password, SID, Voice, Comment ? ?|
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ConnectionID: ?Unique string used to identify to the SQL function ? ?|
| ? ? ? ? ? ? ? ? ? ?calls and the REXX code this Oracle connection. ? ? ? |
| ? ? ? ? ? ? ? ? ? ?Each call must use an unique ConnectionID, even if ? ?|
| ? ? ? ? ? ? ? ? ? ?the call is to the same username/SID combination. ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Username: ? ? ?Oracle username used to connect to the SID. ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Password: ? ? ?Password of the Oracle username. ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? SID: ? ? ? ? ? Oracle service identifier (TNSNAMES.ORA entry) ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Voice: ? ? ? ? If null, use !!Say_Directed to inform the user ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ?of the connection and information. ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Comment: ? ? ? Comment field (optional) providing a purpose for ? ? ?|
| ? ? ? ? ? ? ? ? ? ?creating this connection. ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? The return code from this routine can be: ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? 0: ? ? Successful. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? 2010: ?ConnectionID already exists.? NOTE: ?Each call must use an ? ?|
| ? ? ? ? ? ?unique ConnectionID, even if to the same username/SID ? ? ? ? |
| ? ? ? ? ? ?combination. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? return code from SQLConnect. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!Oracle_Connect: procedure expose (GBL.List) sqlca.
parse arg ConnectionID, CUsername, CPassword, CSID, CVoice, CComment
?
do GOC = 1 to GBL.Oracle_Connection.0
? if GBL.Oracle_Connection.ID.GOC ? ? = ConnectionID then do
? ? call !!Say_Directed 2010, 'e', 'Connection' ConnectionID 'is already in use.'
? ? call !!Oracle_Connection_Display GOC
? ? return 2010
? ? end
? end
?
crc = SQLConnect(ConnectionID, CUsername, CPassword,, CSID)
if crc < 0 then do
? call !!SQL_Error 'validating' CUsername '/' CPassword '@' CSID, crc, 'CONTINUE'
? return crc
? end
?
GBL.Oracle_Connection.0 = GBL.Oracle_Connection.0 + 1
GOC = GBL.Oracle_Connection.0
?
GBL.Oracle_Connection.ID.GOC ? ? ? = ConnectionID
GBL.Oracle_Connection.Status.GOC ? = 'ACTIVE'
GBL.Oracle_Connection.Username.GOC = CUsername
GBL.Oracle_Connection.Password.GOC = CPassword
GBL.Oracle_Connection.SID.GOC ? ? ?= CSID
GBL.Oracle_Connection.HTOD.GOC ? ? = date('S') time('L')
GBL.Oracle_Connection.MTOD.GOC ? ? = (date('b')-GBL.Oracle_Connection.BaseDate)*86400+time('s')
GBL.Oracle_Connection.Comment.GOC ?= CComment
?
if CVoice = '' then do
? call !!Say_Directed 2011, 'i', 'Connection to Oracle database' CSID 'for' CUsername 'created.'
? call !!Oracle_Connection_Display GOC, 'log'
? end
?
return 0
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!Oracle_Disconnect: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Purpose: ?Disconnect an Oracle username/SID and keep track of it ? |
| ? ? ? ? ? ? ? ? for debugging and ease of programming. ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? ConnectionID, Action, Voice ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ConnectionID: ?Unique string used to identify to the SQL function ? ?|
| ? ? ? ? ? ? ? ? ? ?calls and the REXX code this Oracle connection. ? ? ? |
| ? ? ? ? ? ? ? ? ? ?Each call must use an unique ConnectionID, even if ? ?|
| ? ? ? ? ? ? ? ? ? ?the call is to the same username/SID combination. ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ?NOTE: ?If the ConnectionID is "ALL" then this section |
| ? ? ? ? ? ? ? ? ? ?disconnects all outstanding/active connections. ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Action: ? ? ? ?Transaction action to take against this connection. ? |
| ? ? ? ? ? ? ? ? ? ?NONE: ?No action, let the SQL/REXX-Oracle default. ? ?|
| ? ? ? ? ? ? ? ? ? ?COMMIT: ?Commit the transaction(s). ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ?ROLLBACK: ?Rollback the tranaction(s). ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? Voice: ? ? ? ? If null, use !!Say_Directed to inform the user ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ?of the disconnect and information. ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? The return code from this routine can be: ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? 0: ? ? Successful. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? 2012: ?ConnectionID not found to be an active Oracle connection. ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? 62xxx: Action (commit/rollback) failed ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? return code from SQLDisconnect. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!Oracle_Disconnect: procedure expose (GBL.List) sqlca.
parse arg ConnectionID, ActionCode, Voice
?
if translate(ConnectionID) = 'ALL' then do
? do GOC = 1 to GBL.Oracle_Connection.0
? ? if GBL.Oracle_Connection.Status.GOC = 'ACTIVE' then do
? ? ? rc = !!Oracle_Disconnect(GBL.Oracle_Connection.ID.GOC,ActionCode,Voice)
? ? ? if rc > 62000 then do
? ? ? ? rc = !!Oracle_Disconnect(GBL.Oracle_Connection.ID.GOC,'NONE',Voice)
? ? ? ? end
? ? ? end
? ? end
? return 0
? end
?
found = 0
do GOC = 1 to GBL.Oracle_Connection.0
? if GBL.Oracle_Connection.ID.GOC ? ? = ConnectionID & ,
? ? ?GBL.Oracle_Connection.Status.GOC = 'ACTIVE' ? ? then do
? ? found = GOC
? ? leave
? ? end
? end
if found = 0 then do
? call !!Say_Directed 2012, 'e', 'Connection' ConnectionID 'not found to be an active Oracle connection.'
? return 2012
? end
?
select
? when translate(ActionCode) = 'NONE' then do
? ? nop
? ? end
? when translate(ActionCode) = 'COMMIT' then do
? ? rc = SQLDefault(ConnectionID)
? ? rc = SQLCommit()
? ? if rc < 0 then do
? ? ? call !!SQL_Error 'committing data while disconnecting from connection' ConnectionID, rc, 'CONTINUE'
? ? ? return 62000 + abs(sqlca.intcode)
? ? ? end
? ? end
? when translate(ActionCode) = 'ROLLBACK' then do
? ? rc = SQLDefault(ConnectionID)
? ? rc = SQLRollback()
? ? if rc < 0 then do
? ? ? call !!SQL_Error 'rolling back while disconnecting from connection' ConnectionID, rc, 'CONTINUE'
? ? ? return 62000 + abs(sqlca.intcode)
? ? ? end
? ? end
? otherwise do
? ? nop
? ? end
? end
?
drc = SQLDisconnect(ConnectionID)
if drc < 0 then
? call !!SQL_Error 'disconnecting from connection' ConnectionID, drc, 'CONTINUE'
?
GBL.Oracle_Connection.Status.GOC ? = 'INACTIVE'
?
if voice = '' then do
? call !!Oracle_Connection_Display GOC, 'log'
? end
?
return drc
?
!!Oracle_Connection_Display: procedure expose (GBL.List)
parse arg GOC, Whichfile
?
Age = ((date('b')-GBL.Oracle_Connection.BaseDate)*86400+time('s'))-GBL.Oracle_Connection.MTOD.GOC
AgeSS = FORMAT( Age // 60, 2 )
AgeMinutes = ( Age - AgeSS ) / 60
AgeMM = FORMAT( AgeMinutes // 60, 2 )
AgeHH = FORMAT( ( AgeMinutes - AgeMM ) / 60, 2 )
Age ? = TRANSLATE( AgeHH':'AgeMM':'AgeSS, '0', ' ' )
?
if Whichfile = 'both' | ,
? ?Whichfile = 'dmp' ?then do
? call lineout GBL.DeBugLog.FileName, 'Connection ID ? ? ? =' GBL.Oracle_Connection.ID.GOC
? call lineout GBL.DeBugLog.FileName, 'Connection Status ? =' GBL.Oracle_Connection.Status.GOC
? call lineout GBL.DeBugLog.FileName, 'Connection Username =' GBL.Oracle_Connection.Username.GOC
? call lineout GBL.DeBugLog.FileName, 'Connection SID ? ? ?=' GBL.Oracle_Connection.SID.GOC
? call lineout GBL.DeBugLog.FileName, 'Connection TOD ? ? ?=' GBL.Oracle_Connection.HTOD.GOC
? call lineout GBL.DeBugLog.FileName, 'Connection Age ? ? ?=' Age
? call lineout GBL.DeBugLog.FileName, 'Connection Comment ?=' GBL.Oracle_Connection.COMMENT.GOC
? end
?
if Whichfile = 'both' | ,
? ?Whichfile = 'log' ?then do
? call !!Say_Directed 2013, 'i', 'Connection ID ? ? ? =' GBL.Oracle_Connection.ID.GOC
? call !!Say_Directed 2013, 'i', 'Connection Status ? =' GBL.Oracle_Connection.Status.GOC
? call !!Say_Directed 2013, 'i', 'Connection Username =' GBL.Oracle_Connection.Username.GOC
? call !!Say_Directed 2013, 'i', 'Connection SID ? ? ?=' GBL.Oracle_Connection.SID.GOC
? call !!Say_Directed 2013, 'i', 'Connection TOD ? ? ?=' GBL.Oracle_Connection.HTOD.GOC
? call !!Say_Directed 2013, 'i', 'Connection Age ? ? ?=' Age
? call !!Say_Directed 2013, 'i', 'Connection Comment ?=' GBL.Oracle_Connection.COMMENT.GOC
? end
?
return
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!SQL_Error: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Purpose: ?Process errors from the SQL functions by informing the ? |
| ? ? ? ? ? ? ? ? user of the condition.? Some conditions are NOT fatal. ? |
| ? ? ? ? ? ? ? ? If the caller codes something other than STOP, the ? ? ? |
| ? ? ? ? ? ? ? ? routine returns control, instead of releasing SQL ? ? ? ?|
| ? ? ? ? ? ? ? ? memory and calling EOJ. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? SQL_Error message, SQL call return code, STOP / CONTINUE |
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? message is the message text that will be part of the ? ? |
| ? ? ? ? ? ? ? ? message given to the user (customize part for the call ? |
| ? ? ? ? ? ? ? ? that failed). ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? return code is the return code from the SQL call. ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? GOSTOP denotes if the program should end (e.g. terminal ?|
| ? ? ? ? ? ? ? ? error) or continue.? Anything other than STOP will ? ? ? |
| ? ? ? ? ? ? ? ? cause the program to continue. ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!SQL_Error: procedure expose,
? ? ?(GBL.List) sqlca.
parse arg SQL_Type, return_code, GOSTOP
?
call !!Say_Directed 2001,'e','Error' SQL_Type'. ?rc='return_code
if sqlca.intcode = -1 then do
? call !!Say_Directed 2002,'e','SQLCODE: ?' || x2c(09) || sqlca.sqlcode
? call !!Say_Directed 2002,'e','SQLERRM: ?' || x2c(09) || sqlca.sqlerrm
? call !!Say_Directed 2002,'e','SQLTEXT: ?' || x2c(09) || sqlca.sqltext
? call !!Say_Directed 2002,'e','SQLSTATE: ' || x2c(09) || sqlca.sqlstate
? end
?else do
? ?call !!Say_Directed 2003,'e','INTCODE: ' || x2c(09) || sqlca.intcode
? ?call !!Say_Directed 2003,'e','INTERRM: ' || x2c(09) || sqlca.interrm
? ?end
if GOSTOP <> 'STOP' then return 1
?
call SqlDropFuncs
?
call !!EOJ 62000 + return_code
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!Format_Number: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Purpose: ?Format a number with commas (e.g. 1234 = 1,234) ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? Calling protocol is as a function. ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? say 'Number:' !!Format_Number(number) ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!Format_Number: procedure expose ,
? ? (GBL.List)
parse arg number
?
lnumber = length(number)
if lnumber <= 3 then return number
?
do position = lnumber-3 to 1 by -3
? number = insert(',',number,position)
? end
return number
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!DebugLog: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Purpose: ?Process debug requests to the console and/or other ? ? ? |
| ? ? ? ? ? ? ? ? devices (e.g. disk / logfile). ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? DebugLog num, level, output_line ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? num: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Prefix Number (4 digit right justified) ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? level: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Debug action level.? Support values and actions ? ? |
| ? ? ? ? ? ? ? ? ? ? ?are: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?GBL.DebugLog.LevelMessageOnly (1) ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Display only the message, no other action. ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?GBL.DebugLog.LevelDump ? ? ? ?(2) ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Display the message and dump the variables. ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?GBL.DebugLog.LevelCMD ? ? ? ? (3) ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Display the message and provide the user with a ? ? |
| ? ? ? ? ? ? ? ? ? ? ?REXX interpret command to issue REXX commands. ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?GBL.DebugLog.LevelDumpCMD ? ? (4) ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Display the message, dump the variables, and ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?provide the user with a REXX interpret command ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?to issue REXX commands for additional debugging. ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? output_line: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Message to process ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? GBL.DebugLog.Messages: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Specifies where to direct the message.? Supported ? |
| ? ? ? ? ? ? ? ? ? ? ?methods are: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?both: ?Directs the message to both Say_Directed ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? and the dump file. ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?dmp: ? Directs the message to the dump file only. ? |
| ? ? ? ? ? ? ? ? ? ? ?log: ? Directs the message to Say_Directed. ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? GBL.DebugLog.Variables: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?Specifies where to dump the variables.? Supported ? |
| ? ? ? ? ? ? ? ? ? ? ?locations are: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?both: ?Directs the variables to both the log file ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? and the dump file. ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?dmp: ? Directs the message to the dump file only. ? |
| ? ? ? ? ? ? ? ? ? ? ?log: ? Directs the message to the log file. ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? GBL.DebugLog.Debug: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? Environment variable - DEBUG: ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?Specifies if debugging calls are active (debugging ?|
| ? ? ? ? ? ? ? ? ? ? ?is on or off).? Supported values are: ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?yes / on / active: ? ?Debugging is active. ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?no / off / inactive: ?Debugging is inactive. ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?NOTE: ?The environment variable REXXDEBUG overrides |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? the internal GBL.DebugLog.Debug value. ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? The user can turn debugging on or off ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? dynamically by setting the DEBUG environment |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? variable. ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? NOTE: ?Do NOT use any variables other than ?D_. as ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ?this routine does not protect the caller's ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ?variables.? This also allows this routine to ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ?display those variables.? The main routine should |
| ? ? ? ? ? ? ? ? ? ? ? ?NOT use ?D_. variables. ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!DebugLog:
?D_. = ''
parse arg ?D_.Num, ?D_.Level, ?D_.Message
?
?D_.DebugValue = translate(value('REXXDebug', , GBL.Environment))
select
? when ?D_.DebugValue = 'YES' ? ?| ,
? ? ? ??D_.DebugValue = 'ON' ? ? | ,
? ? ? ??D_.DebugValue = 'ACTIVE' then nop
? when ?D_.DebugValue = 'NO' ? ? ? | ,
? ? ? ??D_.DebugValue = 'OFF' ? ? ?| ,
? ? ? ??D_.DebugValue = 'INACTIVE' then return
? otherwise if GBL.DebugLog.Debug = 'YES' ? ?| ,
? ? ? ? ? ? ? ?GBL.DebugLog.Debug = 'ON' ? ? | ,
? ? ? ? ? ? ? ?GBL.DebugLog.Debug = 'ACTIVE' then nop
? ? ? ? ? ? ?else return
? end
?
?D_.Code = GBL.Say_Directed.ModuleName || right(?D_.Num,4,'0') || 'D'
?D_.Msg ?= substr(date('U'),1,6) || substr(date('S'),1,4) time() ?D_.Code ?D_.Message
?
if GBL.DebugLog.Messages = 'both' | ,
? ?GBL.DebugLog.Messages = 'dmp' ?then do
? call lineout GBL.DebugLog.FileName,?D_.Msg
? ?D_.RC = stream(GBL.DebugLog.FileName, 'C', 'Close')
? end
?
if GBL.DebugLog.Messages = 'both' | ,
? ?GBL.DebugLog.Messages = 'log' ?then do
? call !!Say_Directed ?D_.Num,'D',?D_.Message
? end
?
select
? when ?D_.Level = GBL.DebugLog.LevelMessageOnly then do
? ? nop
? ? end
? when ?D_.Level = GBL.DebugLog.LevelDump ? ? ? ?then do
? ? call !!DebugLogVAR
? ? end
? when ?D_.Level = GBL.DebugLog.LevelCMD ? ? ? ? then do
? ? call !!DebugLogCL
? ? end
? when ?D_.Level = GBL.DebugLog.LevelDumpCMD ? ? then do
? ? call !!DebugLogVAR
? ? call !!DebugLogCL
? ? end
? otherwise nop
? end
?
return
?
!!DebugLogVar:
?
?
if GBL.DebugLog.Variables = 'both' | ,
? ?GBL.DebugLog.Variables = 'dmp' ?then do
?
? do ?D_.GOC = 1 to GBL.Oracle_Connection.0
? ? call !!Oracle_Connection_Display ?D_.GOC, 'dmp'
? ? end
? ?D_.RC = stream(GBL.DebugLog.FileName, 'C', 'Close')
?
? drop ?D_.
? call SysDumpVariables GBL.DebugLog.FileName
? call lineout GBL.DebugLog.FileName,''
? call lineout GBL.DebugLog.FileName,copies('=',80)
? call lineout GBL.DebugLog.FileName,''
? ?D_.RC = stream(GBL.DebugLog.FileName, 'C', 'Close')
? end
?
if GBL.DebugLog.Variables = 'both' | ,
? ?GBL.DebugLog.Variables = 'log' ?then do
?
? do ?D_.GOC = 1 to GBL.Oracle_Connection.0
? ? call !!Oracle_Connection_Display ?D_.GOC, 'log'
? ? end
?
? ?D_.RC = stream(GBL.Say_Directed.Filename, 'C', 'Close')
? drop ?D_.
? call SysDumpVariables GBL.Say_Directed.FileName
? end
?
return
?
!!DebugLogCL:
SIGNAL OFF ERROR
/* SIGNAL OFF FAILURE */
SIGNAL OFF HALT
SIGNAL OFF NOVALUE
SIGNAL OFF SYNTAX
do forever
? say 'Enter REXX instruction or <Enter> to quit'
? parse pull reply
? if reply == '' then leave
? interpret reply
? end
SIGNAL ON ERROR
/* SIGNAL ON FAILURE */
SIGNAL ON HALT
SIGNAL ON NOVALUE
SIGNAL ON SYNTAX
return
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ?Subroutine ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Name: ? ? !!Say_Directed: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Purpose: ?Direct console output lines (e.g. say) to the console ? ?|
| ? ? ? ? ? ? ? ? and/or another device (e.g. a disk/log file). ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? Syntax/ ? !!Say_Directed num,level,output_line ? ? ? ? ? ? ? ? ? ? |
| ? ? ? Setup: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? num: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Prefix Number (4 digit right justified) ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? level: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Message Level.? Recommended values are: ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?D: ?Debug ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?I: ?Informational ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?W: ?Warning ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?E: ?Error ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?T: ?Terminal Error condition ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?R: ?Response required ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? output_line: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Message to process ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? GBL.Say_Directed.Console: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?Specifies where to direct the output.? Supported ? ?|
| ? ? ? ? ? ? ? ? ? ? ?methods are: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?console: ?Directed to standard out (e.g. console) ? |
| ? ? ? ? ? ? ? ? ? ? ?file: ? ? Log/Disk file.? Name specified in the ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?variable GBL.Say_Directed.FileName ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?Close the logfile after each line. ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?filenc: ? Same as file, but do not close the logfile|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?after each line.? This improves the ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?performance but keeps the logfile locked. |
| ? ? ? ? ? ? ? ? ? ? ?both: ? ? Directed to both the console and file. ? ?|
| ? ? ? ? ? ? ? ? ? ? ?none: ? ? Suppress the output line. ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?The default (no value set or Say_Directed does not ?|
| ? ? ? ? ? ? ? ? ? ? ?recognize the value) is console. ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? GBL.Say_Directed.FileName: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?Specifies the log/disk file name. ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? GBL.Say_Directed.TimeStamp: ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?Specifies if the output line should include a time ?|
| ? ? ? ? ? ? ? ? ? ? ?stamp.? Supported methods are: ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ?time: ?Time of Day only, hh:mm:ss ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?date: ?Date only, ? ? ? ?mm/dd/yyyy ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ?both: ?Date and time stamp, mm/dd/yyyy hh:mm:ss ? ? |
| ? ? ? ? ? ? ? ? ? ? ?none: ?No time stamp.? This is the default. ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!Say_Directed: procedure expose,
? ? ?(GBL.List)
parse arg num, level, output_line
?
if GBL.Say_Directed.Prefix = 'yes' then do
? lcode = length(GBL.Say_Directed.ModuleName)
? if lcode > 6 then lcode = 6
? code = substr(GBL.Say_Directed.ModuleName,1,lcode) || right(num,4,'0') || translate(level)
? output_line = code output_line
? end
?
select
? when GBL.Say_Directed.TimeStamp = 'time' then
? ? output_line = time() output_line
? when GBL.Say_Directed.TimeStamp = 'date' then
? ? output_line = substr(date('U'),1,6) || substr(date('S'),1,4) output_line
? when GBL.Say_Directed.TimeStamp = 'both' then
? ? output_line = substr(date('U'),1,6) || substr(date('S'),1,4) time() output_line
? otherwise nop
? end
?
select
? when GBL.Say_Directed.Console = 'file' ? | ,
? ? ? ?GBL.Say_Directed.Console = 'filenc' | ,
? ? ? ?GBL.Say_Directed.Console = 'both' ? | ,
? ? ? ?GBL.Say_Directed.Console = 'bothnc' then do
? ? call lineout GBL.Say_Directed.FileName,output_line
?
? ? if GBL.Say_Directed.Console = 'file' | ,
? ? ? ?GBL.Say_Directed.Console = 'both' then do
? ? ? rc = stream(GBL.Say_Directed.FileName,'C','Close')
? ? ? end
?
? ? if GBL.Say_Directed.Console = 'both' ? | ,
? ? ? ?GBL.Say_Directed.Console = 'bothnc' then do
? ? ? say output_line
? ? ? end
? ? end
?
? when GBL.Say_Directed.Console = 'console' then say output_line
? when GBL.Say_Directed.Console = 'none' then nop
? otherwise say output_line
? end
return
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?End of Job ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
!!EOJ: Procedure expose,
? ? ? (GBL.List)
?
if ARG() = 0 then
? ?eoj_rc = 0
else
? ?eoj_rc = ARG(1)
?
if GBL.LogFile ?<> '' then
? ?do
? ? ? call STREAM GBL.LogFile, 'C', 'CLOSE'
? ? ? if GBL.ErrorCount > 0 then
? ? ? ? ?do
? ? ? ? ? ? say ' ? See' GBL.LogFile
? ? ? ? ?end
? ?end
?
if GBL.Oracle_Connection.0 > 0 then do
? call SqlDropFuncs
? end
?
elapsed_time = TIME('E') ? ? ? ? ? ?/* get elapsed time - sssss.uuuuu */
parse value elapsed_time with seconds '.' micro_seconds
if LEFT( micro_seconds, 1, 1 ) >= 5 then
? ?seconds = seconds + 1
ss = FORMAT( seconds // 60, 2 )
minutes = ( seconds - ss ) / 60
mm = FORMAT( minutes // 60, 2 )
hh = FORMAT( ( minutes - mm ) / 60, 2 )
duration = TRANSLATE( hh':'mm':'ss, '0', ' ' )
?
program_name = TRANSLATE( FILESPEC( 'N', GBL.ProgramPathAndName ) )
call !!Say_Directed 2,'i','EOJ with a return code = ' || eoj_rc ' ' program_name 'at' TIME('N') || ', duration' duration
exit eoj_rc
?
/*------------------------------------------------------------------------*\
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?Trap Routines ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? |
| ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?|
\*------------------------------------------------------------------------*/
ERROR: ? ? ? call !!TRAP_PROCESSING_01 ? SIGL, 'ERROR', ? RC
FAILURE: ? ? call !!TRAP_PROCESSING_01 ? SIGL, 'FAILURE', RC
HALT: ? ? ? ?call !!TRAP_PROCESSING_01 ? SIGL, 'HALT', ? ?''
LOGIC_ERROR: call !!TRAP_PROCESSING_01 ? SIGL, 'LOGIC', ? ARG( 1 )
NOVALUE: ? ? call !!TRAP_PROCESSING_01 ? SIGL, 'NOVALUE', ''
SYNTAX: ? ? ?call !!TRAP_PROCESSING_01 ? SIGL, 'SYNTAX', ?RC
?
!!TRAP_PROCESSING_01:
? ?SIGNAL ON ERROR ? name !!TRAP_PROCESSING_02 /* prevent recursion */
/* ? SIGNAL ON FAILURE NAME !!TRAP_PROCESSING_02 */ /* PREVENT RECURSION */
? ?SIGNAL ON HALT ? ?name !!TRAP_PROCESSING_02 /* prevent recursion */
? ?SIGNAL ON NOVALUE name !!TRAP_PROCESSING_02 /* prevent recursion */
? ?SIGNAL ON SYNTAX ?name !!TRAP_PROCESSING_02 /* prevent recursion */
? ??Trap. ? = '' ? ? /* Revised 98/05/03 */
? ?TRAP_DMP = '' ? ? /* .DMP path & file name */
? ?TRAP_DMP_TIMESTAMP = DATE( ) || COPIES(' ', 2 ) || LEFT( TIME('L'),11 )
?
GBL.TraceValue = TRANSLATE( VALUE('REXXTRACE',, GBL.Environment ) )
if GBL.TraceValue == 'L' | GBL.TraceValue == 'R' then
? ?do
? ? ? call TRACE GBL.TraceValue
? ?end
?
/*---------------------*\
| ?Program path & name ?|
\*---------------------*/
parse Source ??Trap.?OperatingSystem . ?Trap.?ProgramPathAndFileName
parse Version ?Trap.?RexxVersion
?
?Trap.?LineNumber = ARG( 1 )
if POS( ':', ?Trap.?ProgramPathAndFileName ) > 0 then
? ?/* get source line if it is available */
? ?do ?T = 1
? ? ? TRAP_SOURCE_LINE.?T = ?SOURCELINE( ?Trap.?LineNumber )
? ? ? TRAP_SOURCE_LINE.0 ?= ?T
? ? ? if TRAP_SOURCE_LINE.?T == '' then
? ? ? ? ?do
? ? ? ? ? ? TRAP_SOURCE_LINE.?T = 'Source is not available'
? ? ? ? ? ? leave
? ? ? ? ?end
? ? ? ?Trap.?LineNumber ? = ?Trap.?LineNumber + 1
? ? ? if RIGHT( TRAP_SOURCE_LINE.?T, 1 ) <> ',' then
? ? ? ? ?do
? ? ? ? ? ? leave
? ? ? ? ?end
? ?end
else
? ?/* program is running in macrospace */
? ?do
? ? ? ?Trap.?ProgramPathAndFileName =,
? ? ? ? ?STRIP( DIRECTORY( ), 'T', '\' ) || '\' ||,
? ? ? ? ??Trap.?ProgramPathAndFileName
? ? ? TRAP_SOURCE_LINE.1 = 'Source line is not available.'
? ? ? TRAP_SOURCE_LINE.0 = 1
? ?end
?
parse value FILESPEC( 'N', ?Trap.?ProgramPathAndFileName ) with,
? ??Trap.?Fn '.' ?Trap.?Fe
TRAP_DMP =,
? ?FILESPEC( 'D', ?Trap.?ProgramPathAndFileName ) ||,
? ?FILESPEC( 'P', ?Trap.?ProgramPathAndFileName ) ||,
? ??Trap.?Fn || '.' || 'DMP'
?
/*-------------------------------------------*\
| ?Determine whether ANSII or VX-REXX output ?|
\*-------------------------------------------*/
?Trap.?VXREXX = ( RxFuncQuery( 'VRWindow' ) = 0 )
if ?Trap.?VXREXX then
? ?do
? ? ? /* see if Primary Window handle exists */
? ? ? ?Trap.?VXREXX = ( LEFT( VRWindow( ), 1 ) = '?' )
? ?end
?
/*------------------------------------------*\
| ?Check for reason NOT to create .DMP file ?|
\*------------------------------------------*/
select
? ?when ARG( 2 ) = 'HALT' then
? ? ? do
? ? ? ? ?TRAP_DMP = ''
? ? ? end
? ?when POS( ':', TRAP_DMP ) = 0 then
? ? ? do
? ? ? ? ?TRAP_DMP = ''
? ? ? end
? ?when ?Trap.?OperatingSystem = 'OS/2' then
? ? ? do
? ? ? ? ?if RxFuncQuery( 'VARDUMP' ) <> 0 then
? ? ? ? ? ? do
? ? ? ? ? ? ? ?TRAP_DMP = ''
? ? ? ? ? ? end
? ? ? end
? ?otherwise
? ? ? do
? ? ? ? ?if LEFT( ?Trap.?RexxVersion, 7 ) == 'OBJREXX' then
? ? ? ? ? ? do
? ? ? ? ? ? ? ??Trap.?DoOver = 1
? ? ? ? ? ? end
? ? ? ? ?else
? ? ? ? ? ? do
? ? ? ? ? ? ? ?TRAP_DMP = ''
? ? ? ? ? ? end
? ? ? end
end
?
/*------------------------*\
| ?Build trap message box ?|
\*------------------------*/
?DBL.H ? ? = 'CD'x ? ? ? ? ? ? ? ? /* ? double line - horizontal ? */
?DBL.V ? ? = 'BA'x ? ? ? ? ? ? ? ? /* ? double line - vertical ? ? */
?DBL.BL ? ?= 'C8'x ? ? ? ? ? ? ? ? /* ? double line - bottom left ?*/
? ? ?= 'BC'x ? ? ? ? ? ? ? ? /* ? double line - bottom right */
? ? ?= 'C9'x ? ? ? ? ? ? ? ? /* ? double line - top left ? ? */
? ? ?= 'BB'x ? ? ? ? ? ? ? ? /* ? double line - top right ? ?*/
if ?Trap.?OperatingSystem <> 'WindowsNT' then
? ?do
? ? ? ?Trap.?RED = '1B'x || '[1;37;41m' ?/* bright white on red ? ?*/
? ? ? ?Trap.?DUL = '1B'x || '[0m' ? ? ? ?/* reset to normal ? ? ? ?*/
? ?end
?Trap.?Margin = COPIES( ' ', 2 )
?
TRAP_ERROR_DESCRIPTION =,
? ?'Error line = ' || ARG( 1 ) || '; ' || ARG( 2 ) || ' trap caught'
if ARG( 3 ) <> '' then
? ?TRAP_ERROR_DESCRIPTION = TRAP_ERROR_DESCRIPTION ||,
? ? ? ' ?Return code = ' || ARG( 3 )
?
?T=0
?T=?T+1; ?Trap.?line.?T = ?Trap.?Fn'.'?Trap.?Fe
?T=?T+1; ?Trap.?line.?T = TRAP_ERROR_DESCRIPTION
if TRAP_DMP <> '' then
? ?do
?T=?T+1; ?Trap.?line.?T = ''
?T=?T+1; ?Trap.?line.?T = 'See: ' || TRAP_DMP
? ?end
?T=?T+1; ?Trap.?line.?T = ''
?T=?T+1; ?Trap.?line.?T = 'Source line(s) at time of trap:'
do ?S = 1 to TRAP_SOURCE_LINE.0
? ??T=?T+1; ?Trap.?line.?T = ?Trap.?Margin || TRAP_SOURCE_LINE.?S
end
? ? ? ? ??Trap.?line.0 = ?T
if ?Trap.?VXREXX then
? ?do
? ? ? ?Trap.?PrimaryWindowHandle = VRWindow( )
? ? ? call VRSet ??Trap.?PrimaryWindowHandle,,
? ? ? ? ? ? ? ? ? 'BackColor', ? ? ?'White',,
? ? ? ? ? ? ? ? ? 'ForeColor', ? ? ?'Red',,
? ? ? ? ? ? ? ? ? ''
?
? ? ? call VRMessageStem ?Trap.?PrimaryWindowHandle,,
? ? ? ? ? ? ? ? ? ? ? ? ?'?Trap.?line.',,
? ? ? ? ? ? ? ? ? ? ? ? ?CENTER( ?Trap.?Fn 'Fatal error', 74 ),,
? ? ? ? ? ? ? ? ? ? ? ? ?'E'
? ?end
else
? ?do
? ? ? ?Trap.?Width = MAX( 74, LENGTH( TRAP_ERROR_DESCRIPTION ) )
? ? ? say ?Trap.?RED || ? || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ? || ?Trap.?DUL
? ? ? say ?Trap.?RED || ?DBL.V ?|| COPIES( ' ', ? ?Trap.?Width + 2 ) || ?DBL.V ?|| ?Trap.?DUL
? ? ? do ?T = 1 to ?Trap.?line.0
? ? ? say ?Trap.?RED || ?DBL.V ? ?LEFT( ?Trap.?line.?T, ?Trap.?Width ) ? ?DBL.V ?|| ?Trap.?DUL
? ? ? end
? ? ? say ?Trap.?RED || ?DBL.V ?|| COPIES( ' ', ? ?Trap.?Width + 2 ) || ?DBL.V ?|| ?Trap.?DUL
? ? ? say ?Trap.?RED || ?DBL.BL || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ? || ?Trap.?DUL
? ?end
?
/*---------------------------------*\
| ?Create .DMP file if appropriate ?|
\*---------------------------------*/
if TRAP_DMP <> '' then
? ?do
? ? ? call SysFileDelete TRAP_DMP
? ? ? if ?Trap.?DoOver = 1 then
? ? ? ? ?do
?
? ? ? ? ? ? ?Trap.?Width = MAX( 74, LENGTH( TRAP_ERROR_DESCRIPTION ) )
? ? ? ? ? ? call LINEOUT TRAP_DMP, ?Trap.?RED || ? || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ? || ?Trap.?DUL
? ? ? ? ? ? call LINEOUT TRAP_DMP, ?Trap.?RED || ?DBL.V ?|| COPIES( ' ', ? ?Trap.?Width + 2 ) || ?DBL.V ?|| ?Trap.?DUL
? ? ? ? ? ? do ?T = 1 to ?Trap.?line.0
? ? ? ? ? ? ? call LINEOUT TRAP_DMP, ?Trap.?RED || ?DBL.V ? ?LEFT( ?Trap.?line.?T, ?Trap.?Width ) ? ?DBL.V ?|| ?Trap.?DUL
? ? ? ? ? ? ? end
? ? ? ? ? ? call LINEOUT TRAP_DMP, ?Trap.?RED || ?DBL.V ?|| COPIES( ' ', ? ?Trap.?Width + 2 ) || ?DBL.V ?|| ?Trap.?DUL
? ? ? ? ? ? call LINEOUT TRAP_DMP, ?Trap.?RED || ?DBL.BL || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ? || ?Trap.?DUL
? ? ? ? ? ? call LINEOUT TRAP_DMP, ''
?
? ? ? ? ? ? ?Trap.?OutputLine = "Name=TRAP_DMP_TIMESTAMP, Value='" || TRAP_DMP_TIMESTAMP || "'"
? ? ? ? ? ? call LINEOUT TRAP_DMP, ?Trap.?OutputLine
? ? ? ? ? ? ?Trap.?OutputLine = "Name=TRAP_ERROR_DESCRIPTION, Value='" || TRAP_ERROR_DESCRIPTION || "'"
? ? ? ? ? ? call LINEOUT TRAP_DMP, ?Trap.?OutputLine
? ? ? ? ? ? do ?T = 1 to TRAP_SOURCE_LINE.0
? ? ? ? ? ? ? ??Trap.?OutputLine = "Name=TRAP_SOURCE_LINE." || ?T || ", Value='" || TRAP_SOURCE_LINE.?T || "'"
? ? ? ? ? ? ? ?call LINEOUT TRAP_DMP, ?Trap.?OutputLine
? ? ? ? ? ? end
? ? ? ? ? ? call LINEOUT TRAP_DMP,''
? ? ? ? ? ? call STREAM ?TRAP_DMP, 'C', 'CLOSE'
?
? ? ? ? ? ? drop ?dbl. ?Trap. ?S ?T ?tr?
? ? ? ? ? ? drop ( GBL.DumpExclusionList )
? ? ? ? ? ? drop TRAP_DMP_TIMESTAMP TRAP_ERROR_DESCRIPTION TRAP_SOURCE_LINE.
?
? ? ? ? ? ? call SysDumpVariables TRAP_DMP
/*
? ? ? ? ? ? do ?T over GBL.
? ? ? ? ? ? ? ??Trap.?OutputLine = "Name=GBL." || ?T || ", Value='" || GBL.?T || "'"
? ? ? ? ? ? ? ?call LINEOUT TRAP_DMP, ?Trap.?OutputLine
? ? ? ? ? ? end
? ? ? ? ? ? call STREAM TRAP_DMP, 'C', 'CLOSE'
*/
? ? ? ? ?end
? ? ? else
? ? ? ? ?do
? ? ? ? ? ? /* remove meaningless labels from dump for clarity */
? ? ? ? ? ? drop ?dbl. ?Trap. ?S ?T ?tr?
? ? ? ? ? ? drop ( GBL.DumpExclusionList )
? ? ? ? ? ? call VARDUMP TRAP_DMP ?/* write variables to program.DMP file */
? ? ? ? ?end
? ?end
?
!!TRAP_PROCESSING_02:
? ?SIGNAL OFF ERROR
/* SIGNAL OFF FAILURE */
? ?SIGNAL OFF HALT
? ?SIGNAL OFF NOVALUE
? ?SIGNAL OFF SYNTAX
? ?parse SOURCE operating_system .
? ?call RXQUEUE 'SET', 'SESSION'
? ?if operating_system <> 'OS/2' then
? ? ? do forever
? ? ? ? ?say 'Enter REXX instruction or <Enter> to quit'
? ? ? ? ?parse pull reply
? ? ? ? ?if reply == '' then leave
? ? ? ? ?interpret reply
? ? ? end
? ?exit 255
