$ RDB$SAVE_VERIFY := 'F$VERIFY(0)'
$ IF "''RDB$VERIFY'" .NES. "" THEN SET VERIFY
$ ! Copyright © 1995, 2007, Oracle Corporation.  All Rights Reserved.
$!
$! 	File: RDB$SHOVER.COM
$! 
$! This command procedure displays the current Oracle Rdb environment.
$! Optionally, it displays the current SQL and RDB DISPATCH environments.
$!
$! This command procedure is from Oracle Rdb version 7.0
$!
$! Input Paramaters:
$!
$! 	P1 = (OPTIONAL)
$!		VERSIONS to define logicals showing installed versions
$!		ALL to show common component environments 
$!		NOSYSTEM to suppress the display of SYSTEM environment
$!
$! 	P2 = (OPTIONAL)
$!	        Used when P1 = VERSIONS
$!		NOSHOW to suppress the display of the logicals
$!		version (Ex: 4.1) to define the logical with only a specific
$!			versions installations
$!		
$! 	P3 = (OPTIONAL)
$!		Used when P1 = VERSIONS
$!		NOSHOW to suppress the display of the logicals
$!		ALL to define common component logicals 
$!		version (Ex: 4.1) to define the logical with only a specific
$!			versions installations
$!		
$! 	P4 = (OPTIONAL)
$!		Used when P1 = VERSIONS
$!		NOSHOW to suppress the display of the logicals
$!----------------------------------------------------------------------
$!
$!
$	DELETE = "DELETE"
$	SEARCH = "SEARCH"
$	LAST_NAME = ""
$	P1 = F$EDIT(P1,"UPCASE,COLLAPSE")
$	P2 = F$EDIT(P2,"UPCASE,COLLAPSE")
$	P3 = F$EDIT(P3,"UPCASE,COLLAPSE")
$	P4 = F$EDIT(P4,"UPCASE,COLLAPSE")
$!
$	IF F$EXTRACT(0,7,P1) .EQS. "VERSION" THEN GOTO RETURN_INSTALLED_VERSIONS
$	IF P1 .EQS. "DB_VERSION" THEN GOTO RETURN_DATABASE_VERSION
$	IF P1 .EQS. "DEBUG" THEN GOTO RETURN_DEBUG_INFO
$	IF P1 .EQS. "FIND" THEN GOTO FIND_DATABASES
$!
$	MULTIVERSION = "FALSE"
$	RDBVER = "''F$TRNLNM("RDBVMS$IDENT","LNM$PROCESS")'"
$	RDBTYP = "MULTIVERSION"
$	IF F$TRNLNM("RDMS$VERSION_VARIANT","LNM$PROCESS") .EQS. " " -
	    THEN RDBTYP = "STANDARD"
$	IF RDBVER .NES. "" 
$	THEN
$	    WRITE SYS$OUTPUT "Current PROCESS Oracle "+ -
		"Rdb environment is version ''RDBVER' (''RDBTYP')"
$	    MULTIVERSION = "TRUE"
$	ENDIF
$!
$	RDBVER = "''F$TRNLNM("RDBVMS$IDENT","LNM$JOB")'"
$	RDBTYP = "MULTIVERSION"
$	IF F$TRNLNM("RDMS$VERSION_VARIANT","LNM$JOB") .EQS. " " -
	    THEN RDBTYP = "STANDARD"
$	IF RDBVER .NES. ""
$	THEN
$	    WRITE SYS$OUTPUT "Current JOB Oracle "+ -
		"Rdb environment is version ''RDBVER' (''RDBTYP')"
$	    MULTIVERSION = "TRUE"
$	ENDIF
$!
$	RDBVER = "''F$TRNLNM("RDBVMS$IDENT","LNM$GROUP")'"
$	RDBTYP = "MULTIVERSION"
$	IF F$TRNLNM("RDMS$VERSION_VARIANT","LNM$GROUP") .EQS. " " -
	    THEN RDBTYP = "STANDARD"
$	IF RDBVER .NES. ""
$	THEN
$	    WRITE SYS$OUTPUT "Current GROUP Oracle "+ -
		"Rdb environment is version ''RDBVER' (''RDBTYP')"
$	    MULTIVERSION = "TRUE"
$	ENDIF
$!
$	RDBVER = "''F$TRNLNM("RDBVMS$IDENT","LNM$SYSTEM")'"
$	RDBTYP = "MULTIVERSION"
$	IF F$TRNLNM("RDMS$VERSION_VARIANT","LNM$SYSTEM") .EQS. " " -
	    THEN RDBTYP = "STANDARD"
$	IF RDBVER .NES. "" .AND. P1 .NES. "NOSYSTEM"
$	THEN
$	    WRITE SYS$OUTPUT "Current SYSTEM Oracle "+ -
		"Rdb environment is version ''RDBVER' (''RDBTYP')"
$	    MULTIVERSION = "TRUE"
$	ENDIF
$!
$	IF MULTIVERSION .EQS. "TRUE"
$	THEN
$	    IF P1 .EQS. "ALL" THEN @SYS$COMMON:[SYSLIB]SQL$SHOVER
$	    CALL CLEANUP_RTN
$	    GOTO RDB$EXIT_SUCCESS
$	ENDIF
$	WRITE SYS$OUTPUT " "
$	WRITE SYS$OUTPUT "%You do not have any Rdb MULTIVERSION or "+ -
	    "STANDARD logicals defined."
$	IMAGE_FILENAME = "SYS$COMMON:[SYSLIB]RDMPRV.EXE"
$	IF F$SEARCH(IMAGE_FILENAME) .EQS. ""
$	THEN
$	    WRITE SYS$OUTPUT -
		"%No STANDARD version of Rdb Exists on your system"
$	ELSE
$	    QUOTE="""
$	    GOSUB GET_IDENT_FROM_IMAGE
$	    WRITE SYS$OUTPUT -
		"%The default STANDARD version of Rdb is ''IDENT'"
$	ENDIF
$	WRITE SYS$OUTPUT " "
$	IF P1 .EQS. "ALL" THEN @SYS$COMMON:[SYSLIB]SQL$SHOVER
$	CALL CLEANUP_RTN
$	GOTO RDB$EXIT_SUCCESS
$
$ RDB$EXIT_FAILURE:
$	RDB$SAVE_VERIFY := 'F$VERIFY(RDB$SAVE_VERIFY)'
$	EXIT %X10000000
$ RDB$EXIT_SUCCESS:
$	RDB$SAVE_VERIFY := 'F$VERIFY(RDB$SAVE_VERIFY)'
$	EXIT 1
$!-----------------------------------------------------------------------------

$ CLEANUP_RTN: SUBROUTINE
$	ON WARNING THEN CONTINUE
$	ON CONTROL_Y THEN CONTINUE
$ ENDSUBROUTINE

$ DELETE_SYMBOL: SUBROUTINE
$ ! (IN ) P1 = symbol
$	SET NOON
$	DEFINE/USER SYS$ERROR _NL:
$	DEFINE/USER SYS$OUTPUT _NL:
$   	DELETE/SYMBOL/GLOBAL 'P1'
$	SET ON
$ ENDSUBROUTINE

$ RETURN_INSTALLED_VERSIONS:
$!
$	QUOTE="""
$	INSTALLED_VERSIONS = ""
$	SHOW_CLIENTS = ""
$	SHOW_PARAM = ""
$!
$	IF P2 .EQS. "NOSHOW" .OR. -
	   P3 .EQS. "NOSHOW" .OR. -
	   P4 .EQS. "NOSHOW"
$	THEN
$	    SHOW_PARAM = "NOSHOW"
$	ENDIF       
$!
$	IF P2 .EQS. "ALL" .OR. -
	   P3 .EQS. "ALL" .OR. -
	   P4 .EQS. "ALL"
$	THEN
$	    SHOW_CLIENTS = "ALL"
$	ENDIF       
$!
$	IF P2 .EQS. "NOSHOW" .OR. -
	   P2 .EQS. "ALL"
$	THEN
$	    P2 = ""
$	ENDIF
$!
$	SHOW_VARIANT = P2
$	IF SHOW_VARIANT .NES. ""
$	THEN
$	    IF F$LOCATE(".",SHOW_VARIANT) .NE. F$LENGTH(SHOW_VARIANT)
$	    THEN 
$		MAJ_VER = "''F$ELEMENT(0,".", SHOW_VARIANT)'"
$		MIN_VER = "''F$ELEMENT(1,".", SHOW_VARIANT)'"
$	    ELSE
$		MAJ_VER = "''F$EXTRACT(0,1,SHOW_VARIANT)'"
$		MIN_VER = "''F$EXTRACT(1,1,SHOW_VARIANT)'"
$		SHOW_VARIANT = MAJ_VER + "." + MIN_VER
$	    ENDIF
$	    IF F$TYPE (MAJ_VER) .NES. "INTEGER" .OR. -
		F$TYPE (MIN_VER) .NES. "INTEGER"
$	    THEN
$		WRITE SYS$OUTPUT "%RDB-E-SHOVER Invalid parameter ''P2'"
$		GOTO RDB$EXIT_FAILURE
$	    ENDIF   
$	ENDIF
$!
$ GET_NEXT:
$!
$	IMAGE_FILENAME = F$SEARCH("SYS$COMMON:[SYSLIB]RDMPRV*.EXE")
$	IF IMAGE_FILENAME .EQS. "" THEN GOTO FINISHED
$	IMAGE_NAME = F$PARSE(IMAGE_FILENAME,,,"NAME")
$	IMAGE_NAME = F$EXTRACT(0,F$LOCATE("_",IMAGE_NAME),IMAGE_NAME)
$	GOSUB GET_IDENT_FROM_IMAGE
$	IF IDENT .EQS. "" THEN GOTO GET_NEXT
$!
$! If P2 is specified, then use it as a version number filter.
$!
$	IF SHOW_VARIANT .NES. ""
$	THEN
$	    IF F$LOCATE(SHOW_VARIANT,IDENT) .EQ. F$LENGTH(IDENT) THEN -
		GOTO GET_NEXT
$	ENDIF
$	IF IMAGE_NAME .EQS. LAST_NAME THEN GOTO GET_NEXT
$	IF F$LOCATE("RDMPRV_",IMAGE_FILENAME) .NE. F$LENGTH(IMAGE_FILENAME) -
	    THEN GOTO GET_NEXT
$	IF  F$LOCATE(IDENT,INSTALLED_VERSIONS) .NE. F$LENGTH(INSTALLED_VERSIONS) -
	    THEN GOTO GET_NEXT
$	IF INSTALLED_VERSIONS .NES. "" THEN -
	    INSTALLED_VERSIONS = INSTALLED_VERSIONS + ","
$	IF  F$LOCATE("RDMPRV.EXE",IMAGE_FILENAME) .EQ. F$LENGTH(IMAGE_FILENAME) -
	    THEN INSTALLED_VERSIONS = INSTALLED_VERSIONS + "*"
$	INSTALLED_VERSIONS = INSTALLED_VERSIONS + IDENT
$	IF F$LOCATE("_",IMAGE_NAME) .NE. F$LENGTH(IMAGE_NAME)
$	THEN
$	    LAST_NAME = F$EXTRACT(0,F$LOCATE("_",IMAGE_NAME),IMAGE_NAME)
$	ELSE
$	    LAST_NAME = IMAGE_NAME
$	ENDIF
$	GOTO GET_NEXT
$!
$ FINISHED:
$!
$	IF INSTALLED_VERSIONS .EQS. ""
$	THEN
$	    DEFINE/PROCESS/NOLOG RDBVMS$INSTALLED_VERSIONS " "
$	ELSE
$	    DEFINE/PROCESS/NOLOG RDBVMS$INSTALLED_VERSIONS 'INSTALLED_VERSIONS'
$	ENDIF
$	IF SHOW_PARAM .NES. "NOSHOW" THEN SHOW LOGICAL RDBVMS$INSTALLED_VERSIONS
$	IF SHOW_CLIENTS .EQS. "ALL" THEN -
	    @SYS$COMMON:[SYSLIB]SQL$SHOVER "VERSIONS" "''SHOW_VARIANT'" "''SHOW_PARAM'"
$	CALL CLEANUP_RTN
$	GOTO RDB$EXIT_SUCCESS
$!
$! Subroutine to get the image ident from the file IMAGE_FILENAME
$!
$ GET_IDENT_FROM_IMAGE:
$!
$	SET NOON
$	ANAL/IMAGE/OUTPUT=NLA0:/SELECT=IDENT 'IMAGE_FILENAME'
$	IF .NOT. $STATUS THEN GOTO RDB$_ERROR
$	SET ON
$	IDENT_STRING = ANALYZE$IDENTIFICATION
$	QUOTE_POS = F$LOCATE(QUOTE,IDENT_STRING)
$	IF QUOTE_POS .EQ. F$LENGTH(IDENT_STRING) THEN GOTO VARIANT_1
$	IF F$EXTRACT(QUOTE_POS+1,7,IDENT_STRING) .NES. "RDB/VMS" .AND. -
	   F$EXTRACT(QUOTE_POS+1,7,IDENT_STRING) .NES. "DEC RDB" .AND. -
	   F$EXTRACT(QUOTE_POS+1,3,IDENT_STRING) .NES. "RDB"
$	THEN
$	    GOTO VARIANT_1
$	ENDIF	
$	IF F$EXTRACT(QUOTE_POS+1,4,IDENT_STRING) .EQS. "RDB "
$	THEN
$	    IDENT_STRING = F$EXTRACT(QUOTE_POS+5,100,IDENT_STRING)
$	ELSE
$	    IDENT_STRING = F$EXTRACT(QUOTE_POS+9,100,IDENT_STRING)
$	ENDIF	
$	QUOTE_POS = F$LOCATE(QUOTE,IDENT_STRING)
$	IF QUOTE_POS .EQ. F$LENGTH(IDENT_STRING) THEN GOTO VARIANT_1
$	IDENT = "''F$EXTRACT(0,QUOTE_POS,IDENT_STRING)'"
$	IDENT = "''F$EXTRACT(0,7,IDENT)'"
$!
$ RETURN
$!-----------------------------------------------------------------------------
$ VARIANT_1:
$	IDENT = "??.?-?"
$	RETURN
$!-----------------------------------------------------------------------------
$ RETURN_DATABASE_VERSION:
$	IF F$TRNLNM("COMMAND_HANDLE ") .NES. "" THEN CLOSE COMMAND_HANDLE
$	IF F$TRNLNM("JOURNAL_HANDLE") .NES. "" THEN CLOSE JOURNAL_HANDLE
$	TEMP_COMMAND = "SYS$SCRATCH:"+F$GETJPI("","PID")+".COM"
$	TEMP_JOURNAL = "SYS$SCRATCH:"+F$GETJPI("","PID")+".JNL"
$	IF F$SEARCH(P2) .EQS. ""
$	THEN
$	    WRITE SYS$OUTPUT " "
$	    WRITE SYS$OUTPUT "%Couldn't find specified database. Please"
$	    WRITE SYS$OUTPUT "%specify the complete database root filename"
$	    WRITE SYS$OUTPUT " "
$	    GOTO RDB$EXIT_FAILURE
$	ENDIF
$	IF F$SEARCH(TEMP_JOURNAL) .NES "" THEN DELETE 'TEMP_JOURNAL;*/NOLOG
$	OPEN/WRITE COMMAND_HANDLE 'TEMP_COMMAND
$	WRITE COMMAND_HANDLE "$SET NOON"
$	WRITE COMMAND_HANDLE "$DEFINE/USER SYS$OUTPUT NL:"
$	WRITE COMMAND_HANDLE "$DEFINE/USER SYS$ERROR NL:"
$	WRITE COMMAND_HANDLE "$PATCH ''P2'/JOURNAL=''TEMP_JOURNAL'/ABSOLUTE"
$	WRITE COMMAND_HANDLE "EXA/LONG 4"
$	WRITE COMMAND_HANDLE "EXA/DEC/BYTE 8"
$	WRITE COMMAND_HANDLE "EXIT"
$	WRITE COMMAND_HANDLE "$SET ON"
$	CLOSE COMMAND_HANDLE
$	@'TEMP_COMMAND
$	DELETE 'TEMP_COMMAND;*/NOLOG
$	OPEN/READ/ERROR=DBVER_ERROR JOURNAL_HANDLE 'TEMP_JOURNAL
$	ROOT_FLAG = "FALSE"
$ READ_AGAIN:
$	READ/ERROR=DBVER_ERROR/END=DBVER_ERROR JOURNAL_HANDLE JOURNAL_RECORD
$	IF F$EXTRACT(0,8,JOURNAL_RECORD) .EQS. "00000004" .AND. -
	    F$EDIT(F$EXTRACT(9,18,JOURNAL_RECORD),"COLLAPSE") .EQS. "544F4F52" -
	    THEN ROOT_FLAG = "TRUE"
$	IF F$EXTRACT(0,1,JOURNAL_RECORD) .EQS. "8"
$	THEN
$	    IF ROOT_FLAG .EQS. "TRUE"
$	    THEN
$		DB_STRUCTURE = F$EDIT(F$EXTRACT(2,10,JOURNAL_RECORD),"COLLAPSE")
$		WRITE SYS$OUTPUT -
		    "Rdb structure level of ''P2' is ''DB_STRUCTURE'"
$	    ELSE
$		WRITE SYS$OUTPUT "''P2' %is not an Rdb Root File"
$	    ENDIF
$	    CLOSE JOURNAL_HANDLE
$	    DELETE 'TEMP_JOURNAL;*/NOLOG
$	    GOTO RDB$EXIT_SUCCESS
$	ELSE
$	    GOTO READ_AGAIN
$	ENDIF
$ DBVER_ERROR:
$	WRITE SYS$OUTPUT P2+" %Couldn't determine Rdb structure level"
$	IF F$TRNLNM("TEMP_JOURNAL") THEN CLOSE 'TEMP_JOURNAL
$	IF F$SEARCH(TEMP_JOURNAL) .NES. "" THEN DELETE 'TEMP_JOURNAL;*/NOLOG
$	GOTO RDB$EXIT_FAILURE
$!-----------------------------------------------------------------------------
$ RETURN_DEBUG_INFO:
$	WRITE SYS$OUTPUT "Logicals"
$	SHO LOG RD*,SORT*,SQ*,RM*,LNM$*
$	WRITE SYS$OUTPUT " "
$	WRITE SYS$OUTPUT "Symbols"
$	SHO SYM RD*
$	SHO SYM RM*
$	SHO SYM SQ*
$	WRITE SYS$OUTPUT " "
$	PIPE SHOW SYSTEM |  -
	SEARCH/NOSTAT/NOHEADING/NOHIGHLIGHT SYS$INPUT: RDMS_MONITOR,"VMS"
$	@SYS$SHARE:RDB$IMAGE_VERSIONS
$	RETURN
$!-----------------------------------------------------------------------------
$ FIND_DATABASES:
$	CLOSE/NOLOG LOG_HANDLE
$	TEMP = "SYS$SCRATCH:" + F$GETJPI("","PID")
$	TEMP_LOG = TEMP + ".LOG"
$	SHOW DEVICE D/MOUNTED/OUTPUT='TEMP_LOG
$	OPEN/READ LOG_HANDLE 'TEMP_LOG
$ READ_DB_AGAIN:
$	READ/END=READ_DB_END LOG_HANDLE LOG_RECORD
$	LOG_RECORD_LENGTH = F$LENGTH(LOG_RECORD)
$	COLON = F$LOCATE(":",LOG_RECORD)
$	IF COLON .NE. LOG_RECORD_LENGTH
$	THEN
$	    DEVICE = F$EXTRACT(0,COLON+1,LOG_RECORD)
$	    GOSUB FIND_DEVICE_DATABASES
$	ENDIF
$	GOTO READ_DB_AGAIN
$ READ_DB_END:
$	CLOSE LOG_HANDLE
$	DELETE/NOLOG 'TEMP_LOG';*
$	GOTO RDB$EXIT_SUCCESS
$ FIND_DEVICE_DATABASES:
$	IF F$SEARCH(DEVICE+"[000000]*.*") .EQS. ""
$	THEN
$	    WRITE SYS$OUTPUT "''DEVICE' not available."
$	    RETURN
$	ENDIF
$	ROOTFILE_STATUS = 0
$ GET_NEXT_RDB:
$	ROOTFILE = F$SEARCH(DEVICE+"[*...]*.RDB;*")
$	IF ROOTFILE .NES. ""
$	THEN
$	    ROOTFILE_STATUS = 1
$	    @SYS$SHARE:RDB$SHOVER.COM DB_VERSION 'ROOTFILE
$	    GOTO GET_NEXT_RDB
$	ENDIF
$	IF ROOTFILE_STATUS .EQ. 0 THEN WRITE SYS$OUTPUT DEVICE+ -
	    " No databases found."
$	RETURN
$!
$ RDB$_ERROR: 
$	WRITE SYS$OUTPUT "%RDB-E-UNEXERR  Error analyzing image " + -
	    "''IMAGE_FILENAME'"
$	GOTO RDB$EXIT_FAILURE