2402 lines
85 KiB
Plaintext
Executable File
2402 lines
85 KiB
Plaintext
Executable File
******************************************************************************
|
|
*
|
|
* Routine to handle UniVerse Connect Command
|
|
*
|
|
* Module %M% Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenance log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 07/10/97 21061 TFH CONNECT (without argument) should accept LAN nettype
|
|
* 09/11/96 18854 ENF Changes to work with ODBC middleware
|
|
* 04/16/96 18292 AGM Change OS.TYPE for NT
|
|
* 11/28/95 17671 LAG Windows NT port
|
|
* 07/27/95 16892 TFH For UV, recognize when RPC daemon is down or
|
|
* service name (in uvodbc.config) isn't in uvrpcservices
|
|
* 06/30/95 16813 TFH Test for new 'empty passwd' SQLSTATE of IM980
|
|
* 06/28/95 15921 TFH If UV, use sql.col.label instead of sql.col.name
|
|
* 06/28/95 15921 TFH UV-max and UV-expired cause sqlstate = 08001
|
|
* 06/27/95 15921 TFH Handle UV-max-users-exceeded and UV-license-expired
|
|
* 06/13/95 15921 TFH Recognize empty password, give user another chance
|
|
* 06/08/95 15921 TFH UV/RPC error codes changed for username/password
|
|
* 06/08/95 15921 MGM Fix NULL display for uv
|
|
* 06/06/95 15921 TFH Use correct syntax (Pick or not) for CREATE.FILE
|
|
* 06/06/95 15921 TFH (For uniVerse) allow up to 3 attempts to enter valid
|
|
* O/S username/password and name/path of schema/account
|
|
* 06/06/95 15921 TFH Bypass prompts for username, password, and schema if
|
|
* connecting to local uniVerse
|
|
* 05/12/95 15921 TFH Support config file name "uvodbc.config"
|
|
* 03/30/95 15921 MGM Misc changes for uniVerse server
|
|
* 03/25/94 13060 TFH Treat keywords for ".N" case-insensitively
|
|
* 03/25/94 13059 TFH Fix the ".W ?" output when default width is < 10
|
|
* 01/19/94 12869 TFH Improve message if tcpserver dies while CONNECTed
|
|
* 01/18/94 12380 TFH Provide useful message if SQLAllocEnv fails due to
|
|
* running with wrong version of uniVerse
|
|
* 01/17/94 12856 TFH Use TTYGET/TTYSET instead of PTERM, to avoid a
|
|
* problem when using DATA statements as CONNECT's input
|
|
* 01/03/94 12380 TFH Added "invalid service" to message (SequeLink -1280)
|
|
* 12/20/93 12380 TFH Display SQL.DATE data as left-justified
|
|
* 12/20/93 12750 TFH Change msg re: hostname doesn't appear in /etc/hosts
|
|
* 12/10/93 12611 TFH Provide more info if SELECTing unsupported datatype
|
|
* 12/06/93 12663 TFH Implement .I[NVERT], to control input-case-inversion
|
|
* 12/02/93 12380 TFH Change the [ORACLEV6] DBMStype to [ORACLE]
|
|
* 11/23/93 12558 TFH Add block mode which disables semi-colon terminator
|
|
* 11/22/93 12380 TFH .UVOUT now creates a Type 30 file instead of Type 2
|
|
* 11/22/93 12592 TFH Terminology: changed "data source definition" to
|
|
* "data source specification", and changed "database" to
|
|
* "DBMS" except when referring to an Informix "database"
|
|
* 11/22/93 12602 TFH Handle SUCCESS_WITH_INFO return for SQLConnect
|
|
* 11/17/93 12380 TFH Add command (.W ?) to display current width settings
|
|
* 11/17/93 12380 TFH In non-UVOUT mode, automatically verticalize output
|
|
* of SELECT if it won't fit across screen
|
|
* 11/01/93 12442 TFH Clarified message if tcpsrv goes down during CONNECT
|
|
* and added SQLFreeStmt calls after such error.
|
|
* 10/28/93 12380 TFH Moved AllocEnv and AllocConnect after INITPAR so
|
|
* that the 'verbose' and 'debug' flags will have been
|
|
* initialized (in case error occurs on AllocEnv/Conn)
|
|
* 10/28/93 12380 TFH Removed temporary code used to test .PRINT
|
|
* 10/27/93 12442 TFH After processing a SELECT, do SQLFreeStmt calls
|
|
* to unbind columns and close cursor.
|
|
* 10/27/93 12380 TFH Only print up to 3 "additional errors" (subr. 600)
|
|
* 10/26/93 12380 TFH Verbose mode now shows datatype names.
|
|
* 10/12/93 12380 TFH Changed first 2 (dummy) Connects so that the
|
|
* phony password is "" instead of "9999". This
|
|
* is because of Informix requirements.
|
|
* 10/05/93 12380 TFH Initial programming
|
|
*
|
|
*******************************************************************************
|
|
|
|
* CONNECT command
|
|
*
|
|
$include UNIVERSE.INCLUDE ODBC.H
|
|
$include UNIVERSE.INCLUDE MACHINE.NAME
|
|
|
|
equ UV.MAX.USERS to 930065 ; * uniVerse error for server usercount exceeded
|
|
equ UV.EXPIRED to 930066 ; * uniVerse error for server license expired
|
|
equ UV.RPCDOWN to 81016 ; * uniVerse error for (probably) RPC daemon down
|
|
equ UV.RPCNOSERV to 81014 ; * uniVerse error: can't find requested service
|
|
equ SL.MAX.USERS to -1280 ; * SequeLink error for server usercount exceeded
|
|
equ SL.EXPIRED to -1005 ; * SequeLink error for server license expired
|
|
equ SL.TIMEOUT to -4014 ; * SequeLink error for connection timeout
|
|
uvmaxusers = UV.MAX.USERS
|
|
uvexpired = UV.EXPIRED
|
|
uvrpcdown = UV.RPCDOWN
|
|
uvrpcnoserv = UV.RPCNOSERV
|
|
slmaxusers = SL.MAX.USERS
|
|
slexpired = SL.EXPIRED
|
|
sltimeout = SL.TIMEOUT
|
|
|
|
equ LOCK.SLEEP to 5 ; * number of 2-second intervals to sleep if file locked
|
|
|
|
equ DEFAULT.WIDTH to 10
|
|
equ MIN.WIDTH to 4
|
|
equ MAX.COLS to 50
|
|
equ MAX.SQL.LINES to 38
|
|
equ MAX.DS.DEFS to 99
|
|
equ MAX.HDG.LINES to 5
|
|
equ MAX.DATA.LINES to 5
|
|
equ MIN.VERT.DATA to 4
|
|
equ MIN.VERT.HDG to 4
|
|
|
|
equ COLNAME to 1
|
|
equ COLTYPE to 2
|
|
equ COLPREC to 3
|
|
equ COLSCALE to 4
|
|
equ COLNULLABLE to 5
|
|
equ COLWIDTH to 6
|
|
equ COLJUST to 7
|
|
equ COLMV to 8
|
|
prompt ''
|
|
sqlsave = ""
|
|
ucinstore = ""
|
|
invstore = ""
|
|
|
|
|
|
*
|
|
* If no arguments on command line, display available data sources and exit
|
|
*
|
|
get(arg.,1) server else goto SHOWSERVERS
|
|
|
|
*
|
|
* Now verify that data source is in config file and has a DBMSTYPE and HOST
|
|
gosub VERIFYDS
|
|
* 'dbtype' has been returned - it will be used when doing user authentication
|
|
* 'localhost' has been returned - it will be used when doing user
|
|
* authentication if connecting to uniVerse
|
|
|
|
*
|
|
* Allocate arrays to store column descriptions, column data, and displaywidths
|
|
*
|
|
SETUP:
|
|
precision 9
|
|
dim column(8,MAX.COLS)
|
|
dim data(MAX.COLS)
|
|
dim widths(MAX.COLS)
|
|
* Initialize flags, etc.
|
|
printflag = 0
|
|
header = 0
|
|
linelen = system(2)
|
|
pagelen = system(3)
|
|
form = str("-",linelen)
|
|
defwidth = DEFAULT.WIDTH
|
|
maxcwidth = linelen - 2 ; * set maximum char display width to fit on one line
|
|
truncdata = 1
|
|
isasqlnull = 0
|
|
|
|
* Initial parameter setup
|
|
*
|
|
INITPAR:
|
|
nullvar ="NULL" ; * User may specify another way to display NULL
|
|
prefix = "." ; * Prefix character for local commands
|
|
uvfile = "" ; * Name of uniVerse file to contain output of a SELECT
|
|
uvopen = 0 ; * If non-zero, output of SELECT goes to 'uvfile'
|
|
debug = 0 ; * If non-zero, print debug messages
|
|
verbose = 0 ; * If non-zero, print column-information and full error info
|
|
editkeys = 0 ; * If non-zero, allow cursor-control editing
|
|
blockmode = 0 ; * If non-zero, use blockstr, not ";", as statement terminator
|
|
blockstr = "" ; * In block mode, a line of only this string ends a block
|
|
vmprint = '*' ; * Default VM substitution char
|
|
touv = 0 ; * Connecting to uniVerse. (NO)
|
|
toodbc = 0
|
|
******* uniVerse *************************************************************
|
|
* invmode ="OFF" ; * Default input-case-inversion mode
|
|
if dbtype[1,8] = "UNIVERSE" then
|
|
invmode = "INIT"
|
|
touv = 1
|
|
end
|
|
else
|
|
if dbtype = "ODBC" then toodbc = 1
|
|
invmode = "OFF"
|
|
end
|
|
******************************************************************************
|
|
|
|
* Get and store original input-case-inversion parameters
|
|
gosub GPTERM
|
|
|
|
* Initialize input-case-inversion to default
|
|
subarg = invmode
|
|
gosub SETINVERT
|
|
|
|
* Initialize column widths to default for all columns
|
|
subarg = "*,":defwidth
|
|
gosub SETWIDTH
|
|
|
|
* Template for dictionary records for uniVerse file
|
|
dictrec = 0
|
|
dictrec<1> = 'D'
|
|
dictrec<6> = 'S'
|
|
dictatph = 0
|
|
dictatph<1> = 'PH'
|
|
*
|
|
* These are emacs-ish:
|
|
* ^F moves cursor forward
|
|
* ^B moves cursor backward
|
|
* ^D deletes this character
|
|
* ^I goes into insert mode (this is NOT the default)
|
|
* ^O goes into overwrite mode (this IS the default)
|
|
* They can be changed or augmented by CAREFULLY using the KEY subcommand
|
|
keyedit (2,2),(6,6),(8,4),(9,9),(10,15)
|
|
* data iconv('09','MX0C');*********************Trying to force Insert mode
|
|
* input @(10,mycurline) junk ;***********************but this doesn't work
|
|
|
|
*
|
|
* Allocate an ODBC environment
|
|
*
|
|
|
|
func = "SQLAllocEnv"
|
|
status = SQLAllocEnv(henv)
|
|
gosub 100
|
|
* Get a connection environment
|
|
func = "SQLAllocConnect"
|
|
status = SQLAllocConnect(henv,hdbc)
|
|
gosub 200
|
|
|
|
*
|
|
* Loop to process all command line arguments
|
|
*
|
|
cldone = 0 ; *Flag for DOSUBCMD
|
|
argno = 0
|
|
ARGLOOP:
|
|
argno = argno+2
|
|
if argno > 99 then stp = "Too many command line arguments" ; goto LAST
|
|
get(arg.,argno) subcmd then
|
|
get(arg.,argno+1) subarg else
|
|
stp = "Missing argument at end of command line" ; goto LAST
|
|
end
|
|
subcmd = upcase(subcmd)
|
|
gosub DOSUBCMD ;
|
|
begin case
|
|
case cmdstatus = 0 ; * Subcommand was correctly processed
|
|
goto ARGLOOP
|
|
case cmdstatus = 1 ; * Subcommand not recognized
|
|
stp = "Illegal command line argument: ":subcmd:" (arg# ":argno:")"
|
|
goto LAST
|
|
case cmdstatus = 2 ; * Subcommand not implemented, message already printed
|
|
print "Command line arguments ":argno:" and ":argno+1:" ignored"
|
|
goto ARGLOOP
|
|
case cmdstatus = 3 ; * Illegal argument for this subcommand
|
|
stp = "Illegal command line argument: ":subarg:" (arg# ":argno+1:")"
|
|
goto LAST
|
|
case cmdstatus > 3 ; * Message already printed for other error case(s)
|
|
stp = "" ; goto LAST
|
|
end case
|
|
stp = "Unknown cmdstatus" ; goto LAST ; * just in case
|
|
end
|
|
cldone = 1
|
|
|
|
* Do connect with phony O/S username/password and phony DBMS parameters,
|
|
* to test if a connection can be obtained
|
|
*
|
|
* First, set up phony username and password for server O/S
|
|
*
|
|
useros = ""
|
|
passos = ""
|
|
if toodbc ne 0 then goto dologin
|
|
useros = "9qsiuysiu345"
|
|
passos = "sf{}>jh92672"
|
|
func = "SQLSetConnectOption" ; * Set up O/S username for server system
|
|
status = SQLSetConnectOption(hdbc,SQL.OS.UID,useros)
|
|
gosub 300 ;
|
|
|
|
func = "SQLSetConnectOption" ; * Set up O/S password for server system
|
|
status = SQLSetConnectOption(hdbc,SQL.OS.PWD,passos)
|
|
gosub 300 ;
|
|
|
|
func = "SQLConnect"
|
|
status = SQLConnect(hdbc,server,"._&%","")
|
|
gosub 305
|
|
|
|
*
|
|
* Get username/password for the remote operating system
|
|
*
|
|
retryconn = 0
|
|
*
|
|
dologin:
|
|
authvar = @AUTHORIZATION
|
|
if (touv and localhost) then
|
|
useros = authvar
|
|
goto SKIPUVPROMPTS
|
|
end
|
|
if toodbc ne 0
|
|
then
|
|
useros = authvar
|
|
goto SKIPUVPROMPTS
|
|
end
|
|
|
|
print "Enter your login name for server operating system [":authvar:"]: ":
|
|
input useros
|
|
if useros eq "" then useros = authvar
|
|
|
|
longprompt = 0
|
|
ttyget curinv else stop "Can't do TTYGET"
|
|
if (curinv<4,4> and not(curinv<4,1>)) then longprompt = 1
|
|
if longprompt then
|
|
print "Enter password for ":useros:" (use SHIFT for lower case): ":
|
|
end else
|
|
print "Enter password for ":useros:": ":
|
|
end
|
|
break off ; echo off ; input passos ; echo on ; break on ; print ""
|
|
|
|
* Set up username and password for server O/S
|
|
*
|
|
func = "SQLSetConnectOption" ; * Set up O/S username for server system
|
|
status = SQLSetConnectOption(hdbc,SQL.OS.UID,useros)
|
|
gosub 300 ;
|
|
|
|
func = "SQLSetConnectOption" ; * Set up O/S password for server system
|
|
status = SQLSetConnectOption(hdbc,SQL.OS.PWD,passos)
|
|
gosub 300 ;
|
|
|
|
* Do connect with phony DBMS parameters, to test
|
|
* if the O/S username and password are acceptable
|
|
*
|
|
if toodbc ne 0 then goto SKIPUVPROMPTS
|
|
func = "SQLConnect"
|
|
status = SQLConnect(hdbc,server,"._&%","")
|
|
gosub 310
|
|
|
|
if retryconn > 2 then stp = "Too many login attempts" ; goto LAST
|
|
if retryconn > 0 then goto dologin
|
|
|
|
SKIPUVPROMPTS:
|
|
*
|
|
* DBMS user authentication depends on dbms type
|
|
*
|
|
retryconn = 0
|
|
*
|
|
dblogin:
|
|
begin case
|
|
case dbtype[1,6] = "ORACLE"
|
|
goto getuidpw
|
|
case dbtype[1,6] = "SYBASE"
|
|
goto getuidpw
|
|
case dbtype[1,8] = "INFORMIX"
|
|
goto getinfxid
|
|
case dbtype[1,8] = "UNIVERSE"
|
|
goto getuvid
|
|
case dbtype[1,4] = "ODBC"
|
|
goto getuidpw
|
|
end case
|
|
* dbms type unrecognized
|
|
print "Enter first login parameter for '":server:"' DBMS [":useros:"]: ":
|
|
input username
|
|
if username = "" then username = useros
|
|
print "Enter second login parameter for '":server:"' DBMS: ":
|
|
input password
|
|
goto doconn
|
|
|
|
getuvid:
|
|
username = "IGNORED"
|
|
password = ""
|
|
if not(localhost) then
|
|
print "Enter name or path of remote schema/account [":upcase(useros):"]: ":
|
|
input username
|
|
if username = "" then username = upcase(useros)
|
|
end
|
|
goto doconn
|
|
|
|
getinfxid:
|
|
print "Enter desired Informix database name [":useros:"]: ":
|
|
input username
|
|
if username = "" then username = useros
|
|
print "Enter YES if you want to run in EXCLUSIVE mode [NO]: ":
|
|
input password
|
|
if upcase(password) eq "YES" then
|
|
password = "EXCLUSIVE"
|
|
print "Requesting EXCLUSIVE use of database '":username:"'"
|
|
end
|
|
else
|
|
password = ""
|
|
print "Requesting non_EXCLUSIVE use of database '":username:"'"
|
|
end
|
|
goto doconn
|
|
|
|
*
|
|
* Enter DBMS username/password)
|
|
*
|
|
getuidpw:
|
|
print "Enter username for connecting to '":server:"' DBMS [":useros:"]: ":
|
|
input username
|
|
if username eq "" then username = useros
|
|
|
|
print "Enter password for ":username:": ":
|
|
break off ; echo off ; input password ; echo on ; break on ; print ""
|
|
|
|
doconn:
|
|
************ Do connect; if fails, check why and give appropriate message
|
|
************ 08004= incorrect username/password - in this case retry 3 times
|
|
************ IM998= no config file found
|
|
************ IM997= a config file option is incorrect
|
|
************ IM002= data source is not in config file
|
|
************ IM003= data source type (dbmstype) unknown
|
|
************ 08001= connection across network failed
|
|
func = "SQLConnect"
|
|
status = SQLConnect(hdbc,server,username,password)
|
|
gosub 320
|
|
if retryconn = 0 then goto allocstmt
|
|
if retryconn > 2 then stp = "Too many login attempts" ; goto LAST
|
|
goto dblogin
|
|
|
|
* Now allocate an SQL statement variable
|
|
*
|
|
allocstmt:
|
|
func ="SQLAllocStmt"
|
|
status = SQLAllocStmt(hdbc, hstmt)
|
|
gosub 300
|
|
|
|
|
|
* Main loop which gets an SQL statement to be executed.
|
|
MAINLOOP:
|
|
|
|
printflag = 0
|
|
print server:"> ":
|
|
input sql
|
|
* Convert tabs to spaces, remove redundant spaces, and upcase the first token
|
|
* This is done in a work area 'cmd' so it doesn't affect the input 'sql'
|
|
cmd = trim(change(sql[1,40],CHAR(9)," ",-1))
|
|
if cmd = "" or cmd = " " then goto MAINLOOP
|
|
token = field(cmd," ",1)
|
|
uptoken = upcase(token)
|
|
cmd = ereplace(cmd,token,uptoken,1)
|
|
|
|
* See if this is a local command
|
|
*
|
|
if cmd[1,1] = prefix then
|
|
begin case
|
|
case cmd = prefix:"R" or cmd = prefix:"RECALL"
|
|
goto RECALLSQL
|
|
case cmd[1,2] = prefix:"C"
|
|
goto CHANGESQL
|
|
case cmd[1,2] = prefix:"A"
|
|
goto APPENDSQL
|
|
case cmd = prefix:"X" or cmd = prefix:"EXECUTE"
|
|
if sqlsave ne "" then sql = sqlsave ; goto DOSQL
|
|
else print "There is no stored SQL command" ; goto MAINLOOP
|
|
case cmd = prefix:"P" or cmd = prefix:"PRINT"
|
|
if sqlsave ne "" then printflag = 1 ; sql = sqlsave ; goto DOSQL
|
|
else print "There is no stored SQL command" ; goto MAINLOOP
|
|
case cmd = prefix:"T" or cmd = prefix:"TOP"
|
|
print @(-1) ; goto MAINLOOP
|
|
case cmd = prefix:"Q" or cmd = prefix:"QUIT"
|
|
goto MAINEXIT
|
|
* case cmd = prefix:"F" or cmd = prefix:"FORMAT" **************************
|
|
* goto FORMATUV *******************************************************
|
|
* case cmd = prefix:"H" or cmd = prefix:"HELP" ****************************
|
|
* goto SHOWHELP ******************************************************
|
|
end case
|
|
|
|
if dcount(cmd," ") = 2 then
|
|
subcmd = field(cmd," ",1)
|
|
subarg = field(cmd," ",2)
|
|
gosub DOSUBCMD
|
|
begin case
|
|
case cmdstatus = 0 ; * Subcommand was correctly processed
|
|
goto MAINLOOP
|
|
case cmdstatus = 1 ; * Subcommand was not recognized
|
|
print "Local command not recognized or has wrong number of arguments"
|
|
goto MAINLOOP
|
|
case cmdstatus > 1 ; *Error processing subcommand, msg already printed
|
|
*At least I think there was always a message**********************
|
|
goto MAINLOOP
|
|
end case
|
|
end
|
|
else
|
|
print "Local command not recognized or has wrong number of arguments"
|
|
goto MAINLOOP
|
|
end
|
|
end
|
|
|
|
* Accept multi-line input
|
|
*
|
|
NEXTLINE:
|
|
linect = 1
|
|
endchar = sql[1]
|
|
endblock = 0
|
|
loop while (endchar ne ";" or blockmode) and endchar ne "?" and linect < MAX.SQL.LINES + 1 and not(endblock)
|
|
print "SQL+":
|
|
input sqlext
|
|
if (not(blockmode) and sqlext = "") then sqlext = ";" ; endblock = 1
|
|
if (blockmode and upcase(sqlext) = blockstr) then sqlext = "" ; endblock = 1
|
|
sql = sql:" ":sqlext
|
|
linect = linect + 1
|
|
endchar = sql[1]
|
|
repeat
|
|
if linect > MAX.SQL.LINES then
|
|
print "Too many lines for one statement"
|
|
goto MAINLOOP
|
|
end
|
|
|
|
* Remove trailing ";" or "?" or " ", then remove trailing blanks
|
|
sql = trimb(sql[1,len(sql)-1])
|
|
* In non-blockmode, if statement ended with "?" preceded by ";", remove the ";"
|
|
if endchar = "?" and not(blockmode) then
|
|
if sql[1] = ";" then sql = trimb(sql[1,len(sql)-1])
|
|
end
|
|
|
|
* Save this statement for possible later recall
|
|
sqlsave = sql
|
|
if endchar = "?" then goto MAINLOOP
|
|
|
|
*
|
|
* Execute the SQL statement
|
|
*
|
|
DOSQL:
|
|
|
|
func = "SQLExecDirect"
|
|
status = SQLExecDirect(hstmt, sql)
|
|
unsupdata = 0
|
|
err500 = 0
|
|
gosub 500 ; * See if statement got SQL.ERROR
|
|
if err500 then
|
|
gosub clear500
|
|
goto MAINLOOP
|
|
end
|
|
|
|
*
|
|
* Now find out if any columns were produced.
|
|
*
|
|
numcols = 0
|
|
func = "SQLNumResultCols"
|
|
status = SQLNumResultCols(hstmt, numcols)
|
|
gosub 400
|
|
|
|
*
|
|
* If there were columns, go off to do DescribeCol/BindCol in preparation
|
|
* for fetching data at 16000
|
|
*
|
|
DOCOLS:
|
|
|
|
if numcols ne 0 then
|
|
header = 0
|
|
if uvopen then
|
|
* Clear data and dictionary of uniVerse file
|
|
CLEARFILE tempfile
|
|
CLEARFILE tempdict
|
|
* Create dictionary entries for key (F0 and @ID)
|
|
dictrecid = "F0"
|
|
dictrec<2> = "0"
|
|
dictrec<3> = ""
|
|
dictrec<4> = "F0"
|
|
dictrec<5> = ""
|
|
dictrec<8> = "INT"
|
|
write dictrec to tempdict,dictrecid
|
|
dictrecid = "@ID"
|
|
write dictrec to tempdict,dictrecid
|
|
dictrec<8> = ""
|
|
end
|
|
if verbose or unsupdata then
|
|
if numcols NE 1 then
|
|
print "There are ":numcols:" columns"
|
|
end
|
|
else
|
|
print "There is ":numcols:" column"
|
|
end
|
|
end
|
|
|
|
gosub 10000 ; * Go to Describe columns
|
|
* If any columns have unsupported datatype, then abort this command
|
|
if unsupdata then
|
|
gosub clear500
|
|
unsupdata = 0
|
|
goto MAINLOOP
|
|
end
|
|
|
|
gosub 15000 ; * Go to Bind columns
|
|
numrows = 0
|
|
gosub 16000 ; * Go to Fetch and print data
|
|
* Unbind columns and close cursor associated with hstmt
|
|
func = "SQLFreeStmt - UNBIND"
|
|
status = SQLFreeStmt(hstmt, SQL.UNBIND)
|
|
gosub 400
|
|
func = "SQLFreeStmt - CLOSE"
|
|
status = SQLFreeStmt(hstmt, SQL.CLOSE)
|
|
gosub 400
|
|
end
|
|
else
|
|
* Print number of rows affected by INSERT, UPDATE, DELETE, etc.
|
|
numrows = 0
|
|
func = "SQLRowCount"
|
|
status = SQLRowCount(hstmt,numrows)
|
|
gosub 400
|
|
if numrows eq 65535 then numrows = 0
|
|
if numrows NE 1 then manysel = "s" else manysel = ""
|
|
print numrows:" row":manysel:" affected"
|
|
end
|
|
goto MAINLOOP
|
|
|
|
*
|
|
MAINEXIT:
|
|
* Get rid of the sql statement variable and disconnect from the data source
|
|
* Then free the connection variable
|
|
*
|
|
|
|
func = "SQLFreeStmt - DROP"
|
|
status = SQLFreeStmt(hstmt, SQL.DROP)
|
|
gosub 400
|
|
|
|
func = "SQLDisconnect"
|
|
status = SQLDisconnect(hdbc)
|
|
gosub 300
|
|
|
|
func = "SQLFreeConnect"
|
|
status = SQLFreeConnect(hdbc)
|
|
gosub 300
|
|
|
|
func = "SQLFreeEnv"
|
|
status = SQLFreeEnv(henv)
|
|
gosub 200
|
|
|
|
if uvopen then
|
|
close tempdict
|
|
close tempfile
|
|
end
|
|
|
|
stp = "Disconnecting from '":server:"'" ; goto LAST
|
|
|
|
LAST:
|
|
gosub RPTERM ; * Restore original PTERM parameters for input-case-inversion
|
|
if stp ne "" then print stp
|
|
stop
|
|
|
|
|
|
***********************Subroutines***********************************
|
|
|
|
* Check error status after SQLAllocEnv
|
|
100:*
|
|
begin case
|
|
case status = 0 ; * SQL.SUCCESS
|
|
return
|
|
case status = -1 ; * SQL.ERROR
|
|
* SQLCO license expired or max-user-count exceeded (errtxt has message);
|
|
* OR running with wrong version of uniVerse, probably because user failed
|
|
* to exit from and re-invoke uniVerse after installing SQLCO.
|
|
st = SQLError(henv,SQL.NULL.HDBC,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
if st = -1 then
|
|
print "Failed to allocate an ODBC environment."
|
|
* print " Make sure SQL Client is licensed on this machine."
|
|
print " If this is the initial installation, be sure to exit uniVerse"
|
|
stp = " and then re-invoke it before trying to use SQL Client."
|
|
goto LAST
|
|
end
|
|
if verbose then gosub 240
|
|
gosub 250
|
|
if verbose then stp = "Exiting (subroutine 100)" ; goto LAST
|
|
else stp = "" ; goto LAST
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 100)" ; goto LAST
|
|
|
|
* Check error status after SQLAllocConnect, SQLFreeEnv
|
|
200:*
|
|
begin case
|
|
case status = 0 ; * SQL.SUCCESS
|
|
return
|
|
case status = -1 ; * SQL.ERROR
|
|
st = SQLError(henv,SQL.NULL.HDBC,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
gosub 240
|
|
gosub 250
|
|
stp = "Exiting (subroutine 200)" ; goto LAST
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 200)" ; goto LAST
|
|
|
|
* Print error messages (used by other subroutines)
|
|
230:*
|
|
print func:" error: Status = ":status:" Unexpected status!"
|
|
return
|
|
240:*
|
|
print func:" error: Status = ":status:" SQLState = ":sqstate:
|
|
print " Natcode = ":natcode
|
|
return
|
|
245:*
|
|
print func:" info-only: Status = ":status:
|
|
print " SQLState = ":sqstate:" Natcode = ":natcode
|
|
return
|
|
248:*
|
|
print "Additional error info: Status = ":status:
|
|
print " SQLState = ":sqstate:" Natcode = ":natcode
|
|
return
|
|
250:*
|
|
if verbose then
|
|
* See if tcpserver went down while CONNECT is running
|
|
if field(errtxt,"]",3)[1,10] = "[SequeLink" then gosub 280
|
|
print errtxt
|
|
return
|
|
end
|
|
brakct = dcount(errtxt,"]")
|
|
if brakct > 3 then
|
|
if field(errtxt,"]",3)[1,7] = "Message" then
|
|
errtxt = field(errtxt,"]",2,brakct-1)
|
|
end
|
|
else
|
|
errtxt = field(errtxt,"]",3,brakct-2)
|
|
end
|
|
end
|
|
if brakct = 3 then errtxt = field(errtxt,"]",2,2)
|
|
findstr abs(natcode) in errtxt setting fmv else
|
|
if natcode NE 0 then
|
|
cnat = ":":natcode
|
|
errtxt = fieldstore(errtxt,"]",2,0,cnat)
|
|
errtxt = ereplace(errtxt,"]","",1,1)
|
|
end
|
|
end
|
|
* next line is here because Oracle messages have linefeed character at end
|
|
if errtxt[1] = CHAR(10) then errtxt = errtxt[1,len(errtxt)-1]
|
|
if dcount(errtxt,"]") > 1 and field(errtxt,"]",2)[1,1] NE " " then
|
|
errtxt = ereplace(errtxt,"]","] ",1)
|
|
end
|
|
* See if tcpserver went down while CONNECT is running
|
|
if field(errtxt,"]",1)[1,10] = "[SequeLink" then gosub 280
|
|
print errtxt
|
|
return
|
|
|
|
* See if tcpserver went down while CONNECT is running
|
|
280:*
|
|
tcpdown1 = " Data Source did not respond"
|
|
if touv then
|
|
tcpdown2 = " Possible problem with network or server system."
|
|
end
|
|
else
|
|
tcpdown2 = " Possible problem with network, server system, or SequeLink listener."
|
|
end
|
|
tcpdown3 = " If problem persists, repair it and then restart CONNECT."
|
|
tcpdown = tcpdown1:CHAR(10):tcpdown2:CHAR(10):tcpdown3
|
|
findstr '-4041' in errtxt setting fmv then errtxt = errtxt:tcpdown
|
|
findstr '-4062' in errtxt setting fmv then errtxt = errtxt:tcpdown
|
|
return
|
|
|
|
* Check error status after SQLSetConnectOption, SQLAllocStmt, SQLDisconnect,
|
|
* and SQLFreeConnect
|
|
300:*
|
|
begin case
|
|
case status = 0 ; * SQL.SUCCESS
|
|
return
|
|
case status = -1 ; * SQL.ERROR
|
|
st = SQLError(henv,hdbc,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
gosub 240
|
|
gosub 250
|
|
stp = "Exiting (subroutine 300)" ; goto LAST
|
|
case status = 1 ; * SQL.SUCCESS.WITH.INFO
|
|
st = SQLError(henv,hdbc,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
gosub 245
|
|
gosub 250
|
|
return
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 300)" ; goto LAST
|
|
|
|
* Check error status after first SQLConnect
|
|
305:*
|
|
begin case
|
|
* first case can only occur if server accepts "phony" uid/pw (both OS & DB)
|
|
case status = 0 or status = 1
|
|
func = "SQLDisconnect"
|
|
status = SQLDisconnect(hdbc)
|
|
gosub 300
|
|
return
|
|
case status = -1
|
|
st = SQLError(henv,hdbc,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
if sqstate = "08001" and natcode = -1020 then return ; * normal case
|
|
* next test added for uniVerse
|
|
if (touv and natcode = 80011) then return ; * "normal" uniVerse behavior
|
|
gosub 240
|
|
gosub 250
|
|
gosub 360
|
|
stp = "" ; goto LAST
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 305)" ; goto LAST
|
|
|
|
* Check error status after second SQLConnect
|
|
310:*
|
|
begin case
|
|
* first case can only occur if server accepts "phony" DB logon parameters
|
|
case status = 0 or status = 1
|
|
retryconn = 0
|
|
func = "SQLDisconnect"
|
|
status = SQLDisconnect(hdbc)
|
|
gosub 300
|
|
return
|
|
case status = -1
|
|
st = SQLError(henv,hdbc,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
userpwerr = 0
|
|
if (sqstate = "08001" and natcode = -1020) then userpwerr = 1
|
|
* next test added for uniVerse
|
|
if touv then
|
|
if (natcode = 80011 or natcode = 80019 or sqstate = "IM980") then
|
|
userpwerr = 1
|
|
end
|
|
end
|
|
if userpwerr then
|
|
print "Incorrect username/password"
|
|
retryconn = retryconn+1
|
|
return
|
|
end
|
|
if sqstate = "08004" then retryconn = 0 ; return ; * this is normal case
|
|
* next test added for uniVerse
|
|
if (touv and natcode = 930133) then retryconn = 0 ; return ; * "normal" uV
|
|
gosub 240
|
|
gosub 250
|
|
gosub 360
|
|
stp = "" ; goto LAST
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 310)" ; goto LAST
|
|
|
|
* Check error status after third SQLConnect
|
|
320:*
|
|
begin case
|
|
case status = 0
|
|
retryconn = 0
|
|
return
|
|
case status = 1 ; * SUCCESS_WITH_INFO - eg, Sybase can't find char set file
|
|
st = SQLError(henv,hdbc,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
gosub 245
|
|
gosub 250
|
|
retryconn = 0
|
|
return
|
|
case status = -1
|
|
st = SQLError(henv,hdbc,SQL.NULL.HSTMT,sqstate,natcode,errtxt)
|
|
* next 5 lines added for uniVerse
|
|
if (touv and (natcode = 930133 or natcode = 930137 or natcode = 930127)) then
|
|
print "'":username:"' is a non-existent or invalid schema/account":
|
|
print " on '":server:"'"
|
|
retryconn = retryconn+1
|
|
return
|
|
end
|
|
if sqstate = "08004" then
|
|
print "Incorrect login parameters for '":server:"' DBMS"
|
|
retryconn = retryconn+1
|
|
return
|
|
end
|
|
gosub 240
|
|
gosub 250
|
|
gosub 360
|
|
stp = "" ; goto LAST
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 320)" ; goto LAST
|
|
|
|
* Print additional connect error information (called by other subroutines)
|
|
360:*
|
|
begin case
|
|
case sqstate = "08001"
|
|
begin case
|
|
case natcode = sltimeout
|
|
print "Connection attempt to '":server:"' timed out;":
|
|
print " possible causes are:"
|
|
if touv = 0 then
|
|
print " - SequeLink listener process is not running on server"
|
|
end
|
|
print " - server system is down"
|
|
print " - network is down or overloaded"
|
|
return
|
|
case natcode = slmaxusers
|
|
print "SequeLink licensed maximum user count exceeded on '":
|
|
print server:"' - try later"
|
|
return
|
|
case natcode = slexpired
|
|
print "Invalid service name or expired SequeLink license on '":
|
|
print server:"'"
|
|
return
|
|
case natcode = uvrpcdown
|
|
print "Connection attempt to '":server:"' failed;":
|
|
print " - RPC daemon probably not running"
|
|
return
|
|
case natcode = uvrpcnoserv
|
|
print "Connection attempt to '":server:"' failed;":
|
|
print " - service not found in 'uvrpcservices'"
|
|
return
|
|
case natcode = uvmaxusers
|
|
if touv then
|
|
print "uniVerse licensed maximum user count exceeded on '":
|
|
print server:"' - try later"
|
|
end
|
|
return
|
|
case natcode = uvexpired
|
|
if touv then
|
|
print "Expired uniVerse license on '":
|
|
print server:"'"
|
|
end
|
|
return
|
|
end case
|
|
print "Network connection to Data Source '":server:"' failed"
|
|
return
|
|
case sqstate = "IM003" or sqstate = "IM997" or sqstate = "IM999"
|
|
print "Invalid parameter(s) found in configuration file"
|
|
return
|
|
case sqstate = "IM990" or sqstate = "IM991" or sqstate = "IM992"
|
|
print "SequeLink not authorized, expired license or user count exceeded on '":
|
|
print server:"'"
|
|
return
|
|
end case
|
|
return
|
|
|
|
* Check error status after calls with active hstmt (except SQLExecDirect and
|
|
* SQLFetch)
|
|
400:*
|
|
begin case
|
|
case status = 0 ; * SQL.SUCCESS
|
|
return
|
|
case status = -1 ; * SQL.ERROR
|
|
st = SQLError(henv,hdbc,hstmt,sqstate,natcode,errtxt)
|
|
gosub 240
|
|
gosub 250
|
|
gosub 600
|
|
stp = "Exiting (subroutine 400)" ; goto LAST
|
|
case status = 1 ; * SQL.SUCCESS.WITH.INFO
|
|
st = SQLError(henv,hdbc,hstmt,sqstate,natcode,errtxt)
|
|
* Check for unsupported datatype
|
|
if sqstate = "S1004" then
|
|
if func = "SQLDescribeCol" or func = "SQLColAttributes" then
|
|
unsupdata = 1
|
|
unsupcol = 1
|
|
return
|
|
end
|
|
end
|
|
gosub 245
|
|
gosub 250
|
|
return
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 400)" ; goto LAST
|
|
|
|
* Check error status after SQLExecDirect or SQLFetch
|
|
500:*
|
|
begin case
|
|
case status = 0 ; * SQL.SUCCESS
|
|
return
|
|
case status = 1 ; * SQL.SUCCESS.WITH.INFO
|
|
st = SQLError(henv,hdbc,hstmt,sqstate,natcode,errtxt)
|
|
gosub 245
|
|
gosub 250
|
|
return
|
|
case status = -1 ; * SQL.ERROR
|
|
st = SQLError(henv,hdbc,hstmt,sqstate,natcode,errtxt)
|
|
* Check for unsupported datatype
|
|
if sqstate = "S1004" and func = "SQLExecDirect" then
|
|
unsupdata = 1
|
|
print "Command aborted - Unsupported datatype in one or more columns"
|
|
return
|
|
end
|
|
if verbose then gosub 240
|
|
gosub 250
|
|
err500 = 1
|
|
gosub 600
|
|
return
|
|
end case
|
|
gosub 230
|
|
stp = "Exiting (subroutine 500)" ; goto LAST
|
|
|
|
* If SQLExecDirect or SQLFetch encountered an error,
|
|
* unbind columns and close cursor associated with hstmt
|
|
clear500:
|
|
err500 = 0
|
|
func = "SQLFreeStmt - UNBIND"
|
|
status = SQLFreeStmt(hstmt, SQL.UNBIND)
|
|
gosub 400
|
|
func = "SQLFreeStmt - CLOSE"
|
|
status = SQLFreeStmt(hstmt, SQL.CLOSE)
|
|
gosub 400
|
|
return
|
|
|
|
* Check for additional error information (up to 3 more) in a statement
|
|
600:*
|
|
ct600 = 0
|
|
601:*
|
|
if ct600 > 2 then return
|
|
st = SQLError(henv,hdbc,hstmt,sqstate,natcode,errtxt)
|
|
if st ne SQL.NO.DATA.FOUND then
|
|
ct600 = ct600 + 1
|
|
gosub 248
|
|
gosub 250
|
|
goto 601
|
|
end
|
|
return
|
|
|
|
*
|
|
* Come here to describe columns and compute total display-width (disptot)
|
|
10000:*
|
|
func = "SQLDescribeCol"
|
|
if uvopen then
|
|
selcmd2 = ""
|
|
atphrase = ""
|
|
end
|
|
disptot = 0
|
|
disphdg = 0
|
|
maxhdg = 0
|
|
maxright = 0
|
|
maxleft = 0
|
|
minright = 0
|
|
minleft = 0
|
|
for icol = 1 to numcols
|
|
unsupcol = 0
|
|
status = SQLDescribeCol(hstmt, icol, colname, coltype, colprec, colscale, colnullable)
|
|
gosub 400
|
|
colname = trimb(colname)
|
|
column(COLNAME,icol) = colname
|
|
column(COLTYPE,icol) = coltype
|
|
column(COLPREC,icol) = colprec
|
|
column(COLSCALE,icol) = colscale
|
|
column(COLMV,icol) = 0
|
|
|
|
* Get column-display-size
|
|
func = "SQLColAttributes"
|
|
status = SQLColAttributes(hstmt,icol,SQL.COLUMN.DISPLAYSIZE,junk,colsize)
|
|
gosub 400
|
|
|
|
* If going to uniVerse use sql.col.label instead of sql.col.name
|
|
if touv then
|
|
func = "SQLColAttributes"
|
|
status = SQLColAttributes(hstmt,icol,SQL.COLUMN.LABEL,collabel,junk)
|
|
gosub 400
|
|
column(COLNAME,icol) = collabel
|
|
end
|
|
|
|
* If going to uniVerse is column multivalued
|
|
if touv then
|
|
func = "SQLColAttributes"
|
|
status = SQLColAttributes(hstmt,icol,SQL.COLUMN.MULTIVALUED,junk,colmv)
|
|
gosub 400
|
|
column(COLMV,icol) = colmv
|
|
end
|
|
|
|
10100:*
|
|
if verbose or unsupdata then
|
|
dtype = column(COLTYPE,icol)
|
|
dtname = ''
|
|
begin case
|
|
case dtype = SQL.CHAR ; dtname = 'SQL.CHAR'
|
|
case dtype = SQL.NUMERIC ; dtname = 'SQL.NUMERIC'
|
|
case dtype = SQL.DECIMAL ; dtname = 'SQL.DECIMAL'
|
|
case dtype = SQL.INTEGER ; dtname = 'SQL.INTEGER'
|
|
case dtype = SQL.SMALLINT ; dtname = 'SQL.SMALLINT'
|
|
case dtype = SQL.FLOAT ; dtname = 'SQL.FLOAT'
|
|
case dtype = SQL.REAL ; dtname = 'SQL.REAL'
|
|
case dtype = SQL.DOUBLE ; dtname = 'SQL.DOUBLE'
|
|
case dtype = SQL.DATE ; dtname = 'SQL.DATE'
|
|
case dtype = SQL.TIME ; dtname = 'SQL.TIME'
|
|
case dtype = SQL.TIMESTAMP ; dtname = 'SQL.TIMESTAMP'
|
|
case dtype = SQL.VARCHAR ; dtname = 'SQL.VARCHAR'
|
|
case dtype = SQL.LONGVARCHAR ; dtname = 'SQL.LONGVARCHAR'
|
|
case dtype = SQL.BINARY ; dtname = 'SQL.BINARY'
|
|
case dtype = SQL.VARBINARY ; dtname = 'SQL.VARBINARY'
|
|
case dtype = SQL.LONGVARBINARY ; dtname = 'SQL.LONGVARBINARY'
|
|
case dtype = SQL.BIGINT ; dtname = 'SQL.BIGINT'
|
|
case dtype = SQL.TINYINT ; dtname = 'SQL.TINYINT'
|
|
case dtype = SQL.BIT ; dtname = 'SQL.BIT'
|
|
end case
|
|
if dtname = '' then dtname = 'UNKNOWN.DATATYPE'
|
|
print "Column ":
|
|
if unsupdata and (numcols > 9) and (icol < 10) then print " ":
|
|
print icol:" name is: ":colname:
|
|
if len(colname) < 18 then print space(18-len(colname)):
|
|
if unsupdata then
|
|
print " type is: ":
|
|
if len(dtype) < 2 then print " ":
|
|
print dtype:" (":dtname:")":
|
|
if unsupcol then print "*UNSUPPORTED*":
|
|
print ""
|
|
continue
|
|
end
|
|
print ""
|
|
print "Column ":icol:" type is: ":dtype:" (":dtname:")"
|
|
print "Column ":icol:" prec is: ":colprec
|
|
print "Column ":icol:" scale is: ":colscale
|
|
print "Column ":icol:" dispsize is: ":colsize
|
|
if touv then
|
|
print "Column ":icol:" multi-valued is: ":colmv
|
|
end
|
|
end
|
|
|
|
* Determine column display width (dictwidth) and justification (just)
|
|
just = "R"
|
|
if widths(icol) = "*" then dictwidth = defwidth else
|
|
dictwidth = widths(icol)
|
|
end
|
|
begin case
|
|
case (coltype = SQL.CHAR or coltype = SQL.DATE) ; *DATE added 12/20/93
|
|
just = "L"
|
|
if colsize le maxcwidth and widths(icol) = "*" then
|
|
dictwidth = colsize
|
|
end
|
|
case coltype = SQL.VARCHAR
|
|
just = "T"
|
|
if colsize le maxcwidth and widths(icol) = "*" then
|
|
just = "L"
|
|
dictwidth = colsize
|
|
end
|
|
case coltype = SQL.LONGVARCHAR
|
|
just = "T"
|
|
end case
|
|
if dictwidth < MIN.WIDTH then dictwidth = MIN.WIDTH
|
|
disptot = disptot + dictwidth + 2
|
|
incrhdg = dictwidth
|
|
if len(colname) > dictwidth and widths(icol) = "*" then
|
|
incrhdg = len(colname)
|
|
end
|
|
disphdg = disphdg + incrhdg + 2
|
|
* Gather info (maxhdg,maxright,maxleft,minright,minleft) for vert output
|
|
if len(colname) > maxhdg then maxhdg = len(colname)
|
|
if just = "R" then
|
|
if dictwidth > maxright then maxright = dictwidth
|
|
if dictwidth > minright and widths(icol) ne "*" then
|
|
minright = dictwidth
|
|
end
|
|
end
|
|
else
|
|
if dictwidth > maxleft then maxleft = dictwidth
|
|
if dictwidth > minleft and widths(icol) ne "*" then
|
|
minleft = dictwidth
|
|
end
|
|
end
|
|
column(COLWIDTH,icol) = dictwidth
|
|
column(COLJUST,icol) = just
|
|
|
|
if uvopen then
|
|
* Create dictionary entry for this column
|
|
dictrec<2> = icol
|
|
if nullvar ne "" then dictrec<3> = "S;*;*;'":nullvar:"'"
|
|
else dictrec<3> = ""
|
|
dictrec<4> = colname
|
|
dictrec<5> = dictwidth:just
|
|
dictrecid = "F":icol
|
|
write dictrec to tempdict,dictrecid
|
|
|
|
* Add this column name to select-list for columns in the uniVerse file
|
|
if icol ne 1 then selcmd2 = selcmd2:","
|
|
selcmd2 = selcmd2:"F":icol
|
|
|
|
* Add this column name to @-phrase for dictionary
|
|
atphrase = atphrase:"F":icol:" "
|
|
end
|
|
next icol
|
|
|
|
* Reset column widths to expand column headings if feasible and useful
|
|
if disphdg le linelen and disphdg > disptot then
|
|
for icol = 1 to numcols
|
|
colname = column(COLNAME,icol)
|
|
dictwidth = column(COLWIDTH,icol)
|
|
if len(colname) > dictwidth and widths(icol) = "*" then
|
|
column(COLWIDTH,icol) = len(colname)
|
|
end
|
|
next icol
|
|
end
|
|
* If row won't fit across screen, set up parameters for verticalized output
|
|
if disptot > linelen then
|
|
if (maxhdg + 2) + (MIN.VERT.DATA + 1) > linelen then
|
|
maxhdg = linelen - (MIN.VERT.DATA + 1) - 2
|
|
end
|
|
if (MIN.VERT.HDG + 2) + (maxright + 1) > linelen then
|
|
maxright = linelen - (MIN.VERT.HDG + 2) - 1
|
|
end
|
|
if minright > maxright then minright = maxright
|
|
hdgwidth = maxhdg
|
|
if (maxhdg + 2) + (maxright + 1) > linelen then
|
|
hdgwidth = int (maxhdg * linelen / (maxhdg + 2 + maxright + 1))
|
|
if (hdgwidth + 2) + (minright + 1) > linelen then
|
|
hdgwidth = linelen - (minright + 1) - 2
|
|
end
|
|
end
|
|
else
|
|
if (maxhdg + 2) + (maxleft + 1) > linelen then
|
|
hdgwidth = int (maxhdg * linelen / (maxhdg + 2 + maxleft + 1))
|
|
if (hdgwidth + 2) + (minleft + 1) > linelen then
|
|
hdgwidth = linelen - (minleft + 1) - 2
|
|
end
|
|
end
|
|
end
|
|
if hdgwidth < MIN.VERT.HDG then hdgwidth = MIN.VERT.HDG
|
|
dispwidth = linelen - hdgwidth - 3
|
|
rightwidth = linelen - hdgwidth - 3
|
|
if maxright < rightwidth then rightwidth = maxright
|
|
* Set up counts so that no row will be split across screen boundaries
|
|
vrowcount = int ( (pagelen-1) / (numcols+1) )
|
|
vremlines = mod ( (pagelen-1) , (numcols+1) )
|
|
vcontrol = vrowcount and vremlines and not(printflag)
|
|
if vcontrol then
|
|
vmidline = int ( vremlines / vrowcount )
|
|
if vmidline then vremlines = vremlines - (vrowcount-1)
|
|
vxcount = 0
|
|
end
|
|
else vmidline = 0 ; vremlines = 0 ; vxcount = 0
|
|
******************************************************************************
|
|
if debug then
|
|
print "hdgwidth=":hdgwidth:", dispwidth=":dispwidth:
|
|
print ", rightwidth=":rightwidth
|
|
print "vcontrol=":vcontrol:", vrowcount=":vrowcount:
|
|
print ", vremlines=":vremlines:", vmidline =":vmidline
|
|
print "pagelen=":pagelen
|
|
end
|
|
******************************************************************************
|
|
end
|
|
return ; * return from subroutine 10000
|
|
|
|
*
|
|
* Here we attempt to bind columns in preparation for Fetch
|
|
15000:*
|
|
|
|
func = "SQLFreeStmt - UNBIND"
|
|
status = SQLFreeStmt(hstmt, SQL.UNBIND)
|
|
gosub 400
|
|
|
|
func = "SQLBindCol"
|
|
for icol = 1 to numcols
|
|
data(icol) = func
|
|
status = SQLBindCol(hstmt,icol,SQL.B.DEFAULT,data(icol))
|
|
gosub 400
|
|
next icol
|
|
return
|
|
|
|
*
|
|
* Here to fetch data variables
|
|
16000:*
|
|
func = "SQLFetch"
|
|
status = SQLFetch(hstmt)
|
|
if status = SQL.NO.DATA.FOUND then
|
|
if uvopen then goto SELECTUV else
|
|
if printflag then
|
|
printer on
|
|
if header = 0 then gosub 16200
|
|
end
|
|
if numrows NE 0 then print ""
|
|
if numrows NE 1 then manysel = "s" else manysel = ""
|
|
print numrows:" row":manysel:" selected"
|
|
printer close
|
|
printer off
|
|
return ; * Returns from subr 16000 in default (non-UVOUT) output mode
|
|
end
|
|
end
|
|
|
|
numrows = numrows+1
|
|
|
|
err500 = 0
|
|
gosub 500 ; * This checks the above SQLFetch for errors
|
|
if err500 then
|
|
gosub clear500
|
|
goto MAINLOOP
|
|
end
|
|
|
|
if uvopen then gosub WRITEONE else gosub PRINTONE
|
|
|
|
goto 16000 ; * return to beginning of loop to fetch data from next row
|
|
|
|
16200:*
|
|
printer reset
|
|
timdat = timedate()
|
|
numspac = linelen - ((len(sql)+1) + len(timdat))
|
|
if numspac > 0 then print sql:";":space(numspac):timdat else
|
|
print space(linelen - len(timdat)):timdat
|
|
print sql:";"
|
|
end
|
|
print ""
|
|
return
|
|
|
|
*
|
|
* No more data to be fetched, when writing to a uniVerse file
|
|
SELECTUV:
|
|
dictatph<2> = atphrase
|
|
dictrecid = "@"
|
|
write dictatph to tempdict,dictrecid
|
|
|
|
selcmd1 = "SELECT "
|
|
selcmd3 = " FROM ":uvfile:" ORDER BY F0"
|
|
if printflag then
|
|
ttt = "'T'"
|
|
selcmd = selcmd1:selcmd2:selcmd3:' HEADING "':sql:'; ':ttt:'" LPTR;'
|
|
end
|
|
else
|
|
selcmd = selcmd1:selcmd2:selcmd3:";"
|
|
end
|
|
perform selcmd
|
|
|
|
return ; * This returns from subroutine 16000 when in UVOUT mode
|
|
|
|
*
|
|
* For uniVerse replace the VM with some printable character
|
|
* and converts embedded Nulls to user defined null
|
|
REPLACEVM:
|
|
numvals = DCOUNT(coldata, @VM)
|
|
if (numvals > 1) then
|
|
for ivalue = 1 to numvals
|
|
thisvalue = extract(coldata, 1, ivalue, 0)
|
|
if isnull(thisvalue) then
|
|
coldata = replace(coldata, 1, ivalue, 0, nullvar)
|
|
end
|
|
next ivalue
|
|
coldata = CONVERT(@VM, vmprint, coldata)
|
|
end
|
|
return
|
|
|
|
* Database specific SQL NULL routine
|
|
ISSQLNULL:
|
|
if isnull(coldata)
|
|
then isasqlnull = 1
|
|
else isasqlnull = 0
|
|
return
|
|
|
|
*
|
|
* Display data values for one row (print heading first if not done yet)
|
|
PRINTONE:
|
|
if printflag then
|
|
printer on
|
|
if header = 0 then gosub 16200
|
|
end
|
|
if header = 0 and disptot le linelen then
|
|
gosub longhdg
|
|
for icol = 1 to numcols
|
|
dispwidth = column(COLWIDTH,icol)
|
|
print form[1,dispwidth]:" ":
|
|
next icol
|
|
print ""
|
|
end
|
|
header = 1
|
|
|
|
* If row won't fit across screen, produce vertical output display.
|
|
* The size to be used for column heading is now in 'hdgwidth', the available
|
|
* space on a line for data is in 'dispwidth', and the size to be used for
|
|
* right-justified data is in 'rightwidth'. Column headings which don't fit
|
|
* are truncated (regardless of the .W setting for Fold or Truncate).
|
|
* Left-justified data which doesn't fit is folded if the .W setting is "F".
|
|
* Right-justified data data which doesn't fit within 'rightwidth' is shown
|
|
* anyway if it fits on the current line (ie if it fits within 'dispwidth'),
|
|
* and is then truncated or folded at end of line depending on the F/T setting.
|
|
if disptot > linelen then
|
|
if vcontrol then
|
|
*** Print blank lines so no row is split across screens
|
|
if numrows > 1 and (mod(numrows,vrowcount) = 1 or vrowcount = 1) then
|
|
*** About to print row that won't fit on current screen
|
|
if vxcount > vremlines then vcontrol = 0 ; goto novcontrol
|
|
if vxcount < vremlines then
|
|
for i = 1 to (vremlines - vxcount) ; print "" ; next i
|
|
end
|
|
if vmidline and (numrows = vrowcount+1) then
|
|
for i = 1 to vrowcount-1 ; print "" ; next i
|
|
end
|
|
vxcount = 0
|
|
end
|
|
else
|
|
if vmidline and (numrows > vrowcount) then print ""
|
|
end
|
|
end
|
|
novcontrol:
|
|
print ""
|
|
for icol = 1 to numcols
|
|
* First print column heading for this row
|
|
colname = column(COLNAME,icol)
|
|
if len(colname) > hdgwidth then print colname[1,hdgwidth]:"* ": else
|
|
print colname:str(".",hdgwidth - len(colname) + 1):" ":
|
|
end
|
|
* Now print data for this row
|
|
coldata = data(icol)
|
|
if column(COLMV,icol) then gosub REPLACEVM
|
|
if column(COLJUST,icol) = "R" then
|
|
* This set of code handles right-justified data
|
|
gosub ISSQLNULL
|
|
if isasqlnull then
|
|
print space(rightwidth - len(nullvar)):nullvar
|
|
continue
|
|
end
|
|
if len(coldata) > dispwidth then gosub longvert ; continue
|
|
if len(coldata) > rightwidth then print coldata
|
|
else print space(rightwidth - len(coldata)):coldata
|
|
end
|
|
else
|
|
* This set of code handles left-justified data
|
|
coldata = trimb(coldata)
|
|
gosub ISSQLNULL
|
|
if isasqlnull then print nullvar ; continue
|
|
if len(coldata) > dispwidth then gosub longvert
|
|
else print coldata
|
|
end
|
|
next icol
|
|
return ; * This returns from PRINTONE subr if producing vertical output
|
|
end
|
|
|
|
* Display this row of data (just first portion if folding is needed)
|
|
moredata = 0
|
|
for icol = 1 to numcols
|
|
coldata = data(icol)
|
|
if column(COLMV,icol) then gosub REPLACEVM
|
|
dispwidth = column(COLWIDTH,icol)
|
|
if column(COLJUST,icol) ne "R" then goto printleft
|
|
if len(coldata) > dispwidth then goto printleft
|
|
gosub ISSQLNULL
|
|
if isasqlnull then
|
|
print space(dispwidth-len(nullvar)):
|
|
print nullvar:space(2):
|
|
end
|
|
else
|
|
print space(dispwidth-len(coldata)):
|
|
print coldata:space(2):
|
|
end
|
|
continue
|
|
printleft:
|
|
gosub ISSQLNULL
|
|
if isasqlnull then
|
|
print nullvar:
|
|
print space(dispwidth-len(nullvar)+2):
|
|
end
|
|
else
|
|
if len(coldata) > dispwidth then
|
|
print coldata[1,dispwidth]:
|
|
if truncdata or disptot > linelen then print "* ": else
|
|
print "- ":
|
|
moredata = 1
|
|
end
|
|
end
|
|
else
|
|
print coldata:space(dispwidth-len(coldata)+2):
|
|
end
|
|
end
|
|
next icol
|
|
print ""
|
|
if moredata then gosub longdata
|
|
printer off
|
|
return
|
|
|
|
longdata: ; * display column data (folded up to MAX.DATA.LINES lines)
|
|
for iline = 2 to MAX.DATA.LINES
|
|
moredata = 0
|
|
for icol = 1 to numcols
|
|
coldata = data(icol)
|
|
if column(COLMV,icol) then gosub REPLACEVM
|
|
dispwidth = column(COLWIDTH,icol)
|
|
dispsofar = dispwidth * (iline-1)
|
|
if dispsofar ge len(coldata) then
|
|
print space(dispwidth+2):
|
|
continue
|
|
end
|
|
if len(coldata) > dispsofar + dispwidth then
|
|
moredata = 1
|
|
print coldata[dispsofar+1,dispwidth]:
|
|
if iline = MAX.DATA.LINES then print "* ": else print "- ":
|
|
end
|
|
else
|
|
remdata = mod(len(coldata)-1,dispwidth)+1
|
|
print coldata[dispsofar+1,remdata]:
|
|
print space(dispwidth - remdata + 2):
|
|
end
|
|
next icol
|
|
print ""
|
|
if not(moredata) then return
|
|
next iline
|
|
return
|
|
|
|
longhdg: ; * display column headings (folded if line fits across screen)
|
|
if disptot > linelen then mxlin = 1 else mxlin = MAX.HDG.LINES
|
|
for iline = 1 to mxlin
|
|
morehdg = 0
|
|
for icol = 1 to numcols
|
|
colname = column(COLNAME,icol)
|
|
dispwidth = column(COLWIDTH,icol)
|
|
dispsofar = dispwidth * (iline-1)
|
|
if dispsofar ge len(colname) then
|
|
print space(dispwidth+2):
|
|
continue
|
|
end
|
|
if len(colname) > dispsofar + dispwidth then
|
|
morehdg = 1
|
|
print colname[dispsofar+1,dispwidth]:
|
|
if iline = mxlin then print "* ": else print "- ":
|
|
end
|
|
else
|
|
remhdg = mod(len(colname)-1,dispwidth)+1
|
|
if iline = 1 and column(COLJUST,icol) = "R" then
|
|
print space(dispwidth - remhdg):
|
|
print colname:space(2):
|
|
end
|
|
else
|
|
print colname[dispsofar+1,remhdg]:
|
|
print space(dispwidth - remhdg + 2):
|
|
end
|
|
end
|
|
next icol
|
|
print ""
|
|
if not(morehdg) then return
|
|
next iline
|
|
return
|
|
|
|
longvert: ; * For vertical display, this subroutine handles excessive data
|
|
print coldata[1,dispwidth]:
|
|
if truncdata then print "*" ; return
|
|
print "-"
|
|
for iline = 2 to MAX.DATA.LINES
|
|
dispsofar = dispwidth * (iline-1)
|
|
if dispsofar ge len(coldata) then return
|
|
print space(hdgwidth+2):
|
|
if len(coldata) > dispsofar + dispwidth then
|
|
print coldata[dispsofar+1,dispwidth]:
|
|
if iline = MAX.DATA.LINES then print "*" else print "-"
|
|
end
|
|
else
|
|
remdata = mod(len(coldata)-1,dispwidth)+1
|
|
print coldata[dispsofar+1,remdata]
|
|
end
|
|
vxcount = vxcount + 1
|
|
next iline
|
|
return
|
|
|
|
*
|
|
* Write one row of data into the uniVerse file
|
|
WRITEONE:
|
|
datarec = 0
|
|
for icol = 1 to numcols
|
|
datarec<icol> = data(icol)
|
|
next icol
|
|
write datarec to tempfile,numrows
|
|
return
|
|
|
|
|
|
* Recall last SQL statement (and let user edit it if EDITKEYS = ON)
|
|
RECALLSQL:
|
|
if not(editkeys) then
|
|
if sqlsave = "" then print "There is no stored SQL command"
|
|
else print sqlsave
|
|
goto MAINLOOP
|
|
end
|
|
* The rest of this is questionable code at this time*************************
|
|
* Clear screen
|
|
print @(-1)
|
|
curline = system(6)
|
|
input @(0,curline) sqlsave
|
|
print ""
|
|
* Remove trailing "?" or ";"
|
|
endchar = sqlsave[1]
|
|
if endchar = "?" or endchar = ";" then sqlsave = sqlsave[1,len(sqlsave)-1]
|
|
* Remove trailing blanks
|
|
sqlsave = trimb(sqlsave)
|
|
goto MAINLOOP
|
|
|
|
* Recall last uniVerse statement and let user edit it
|
|
FORMATUV:
|
|
if not(uvopen) then
|
|
print "uniVerse-output mode not active"
|
|
goto MAINLOOP
|
|
end
|
|
if selcmd = "" then
|
|
print "There is no stored uniVerse SELECT command"
|
|
goto MAINLOOP
|
|
end
|
|
if not(editkeys) then
|
|
print selcmd
|
|
* Set flag for .C, .A, .X
|
|
goto MAINLOOP
|
|
end
|
|
print "FORMAT not yet implemented" ; **************************To be completed
|
|
goto MAINLOOP ; ************************************************************
|
|
* The following code is REALLY questionable at this time*******************
|
|
* Clear screen
|
|
print @(-1)
|
|
curline = system(6)
|
|
input @(0,curline) selcmd
|
|
print ""
|
|
***perform selcmd ; * or set flag for .X ************************************
|
|
goto MAINLOOP
|
|
|
|
* Show current parameter settings
|
|
SHOWPARAMS:
|
|
print "SHOW not yet implemented" ; **********************************To be done
|
|
goto MAINLOOP
|
|
|
|
* Provide Help
|
|
SHOWHELP:
|
|
print "HELP not yet implemented" ; **********************************To be done
|
|
goto MAINLOOP
|
|
|
|
* Change current statement (string replacement)
|
|
CHANGESQL:
|
|
* Eventually, check flag to see if editing saved uniVerse SELECT************
|
|
* For now, assume we are editing saved SQL statement*************************
|
|
if sqlsave = "" then print "There is no stored SQL command" ; goto MAINLOOP
|
|
if len(cmd) < 3 then print sqlsave ; goto MAINLOOP
|
|
if cmd[3,1] ne " " then delim = cmd[3,1] else delim = cmd[4,1]
|
|
if ((delim ge "!" and delim le "/") or delim = ":" or delim = "=" or delim = "?" or delim = "@" or (delim ge "[" and delim le "]") or delim = "`" or (delim ge "{" and delim le "}")) then
|
|
sql = trimf(sql[len(sql)-2])
|
|
if upcase(field(sql,delim,4)[1,1]) = "G" and field(sql,delim,2) ne ""
|
|
then numrep = -1
|
|
else numrep = 1
|
|
sqlsave = ereplace(sqlsave,field(sql,delim,2),field(sql,delim,3),numrep)
|
|
goto NEWSAVE
|
|
end
|
|
else print '"':delim:'" is not a valid delimiter' ; goto MAINLOOP
|
|
|
|
* Append string to current statement
|
|
APPENDSQL:
|
|
* Eventually, check flag to see if editing saved uniVerse SELECT************
|
|
* For now, assume we are editing saved SQL statement*************************
|
|
if sqlsave = "" then print "There is no stored SQL command" ; goto MAINLOOP
|
|
sql = sql[len(sql)-2]
|
|
if sql ne "" and sql[1,1] ne " " then
|
|
print 'Character following "':prefix:'A" must be blank'
|
|
goto MAINLOOP
|
|
end
|
|
sqlsave = sqlsave:sql[2,len(sql)-1]
|
|
goto NEWSAVE
|
|
|
|
|
|
*
|
|
* Subroutine to process one local command (subcmd) with its argument (subarg)
|
|
* We know that subcmd and subarg are non-empty strings and subcmd is upcased
|
|
* Results in cmdstatus: 0 subcommand processed correctly
|
|
* 1 subcommand not recognized
|
|
* 2 subcommand not implemented yet (message printed)
|
|
* 3 subcommand has illegal argument (message printed)
|
|
* 4 error while processing subcommand (message printed)
|
|
DOSUBCMD:
|
|
if cldone then prfx = prefix else prfx = ""
|
|
begin case
|
|
case subcmd = prfx:"W" or subcmd = prfx:"WIDTH"
|
|
goto SETWIDTH
|
|
case subcmd = prfx:"N" or subcmd = prfx:"NULL"
|
|
goto SETNULL
|
|
* case subcmd = prfx:"K" or subcmd = prfx:"KEY" ; **********************
|
|
case subcmd = "K" or subcmd = "KEY" ; *experiment only on cmd line ****
|
|
goto SETKEY
|
|
case subcmd = "P" or subcmd = "PREFIX" ; **only allowed on cmd line***
|
|
goto SETPREFIX
|
|
case subcmd = prfx:"U" or subcmd = prfx:"UVOUT"
|
|
goto UVOUT
|
|
case subcmd = prfx:"D" or subcmd = prfx:"DEBUG"
|
|
goto SETDEBUG
|
|
case subcmd = prfx:"V" or subcmd = prfx:"VERBOSE"
|
|
goto SETVERBOSE
|
|
case subcmd = prfx:"B" or subcmd = prfx:"BLOCK"
|
|
goto SETBLOCK
|
|
case subcmd = prfx:"I" or subcmd = prfx:"INVERT"
|
|
goto SETINVERT
|
|
* case subcmd = prfx:"E" or subcmd = prfx:"EDITKEYS" ; *****************
|
|
case subcmd = "E" or subcmd = "EDITKEYS" ; *expermnt only on cmd line**
|
|
goto SETEDMODE
|
|
* next allowed only as a local command
|
|
case (subcmd = prfx:"R" or subcmd = prfx:"RECALL") and cldone
|
|
goto RECALLVOC
|
|
* next allowed only as a local command
|
|
case (subcmd = prfx:"S" or subcmd = prfx:"SAVE") and cldone
|
|
goto SAVEVOC
|
|
case subcmd = prfx:"M" or subcmd = prfx:"MVDISPLAY"
|
|
goto SETVM
|
|
end case
|
|
cmdstatus = 1
|
|
return
|
|
|
|
* Recall a sentence from VOC
|
|
RECALLVOC:
|
|
open "VOC" to vocfile else print "Can't open VOC file" ; goto MAINLOOP
|
|
read vocsent from vocfile,subarg else
|
|
print 'Item "':subarg:'" does not exist in your VOC'
|
|
close vocfile
|
|
goto MAINLOOP
|
|
end
|
|
close vocfile
|
|
vocf1 = trim(change(vocsent<1>,CHAR(9)," ",-1))
|
|
if field(vocf1," ",1) ne "S" then
|
|
print 'Item "':subarg:'" is not a SENTENCE'
|
|
goto MAINLOOP
|
|
end
|
|
sqlsave = vocsent<2>
|
|
|
|
NEWSAVE:
|
|
if sqlsave = "" then sqlsave = "?" ; * This "?" will be immediately removed
|
|
* Remove trailing "?" or ";"
|
|
endchar = sqlsave[1]
|
|
if endchar = "?" or endchar = ";" then sqlsave = sqlsave[1,len(sqlsave)-1]
|
|
* Remove trailing blanks
|
|
sqlsave = trimb(sqlsave)
|
|
print sqlsave
|
|
goto MAINLOOP
|
|
|
|
SAVEVOC:
|
|
if sqlsave = "" then print "There is no stored SQL command" ; goto MAINLOOP
|
|
open "VOC" to vocfile else print "Can't open VOC file" ; goto MAINLOOP
|
|
scount = 0
|
|
svoc1:
|
|
if scount > LOCK.SLEEP then
|
|
print "Record in VOC is locked by user at terminal ":status()
|
|
close vocfile
|
|
goto MAINLOOP
|
|
end
|
|
readu vocsent from vocfile,subarg locked
|
|
sleep 2
|
|
scount = scount+1
|
|
goto svoc1
|
|
end
|
|
then goto svoc2 else goto svoc3
|
|
svoc2:
|
|
vocf1 = trim(change(vocsent<1>,CHAR(9)," ",-1))
|
|
if field(vocf1," ",1) ne "S" then
|
|
print 'Item "':subarg:'" is not a SENTENCE'
|
|
goto svoc4
|
|
end
|
|
print 'Item "':subarg:'" already exists in your VOC'
|
|
print " - Enter option: O) Overwrite, N) Choose a new Name, A) Abort ":
|
|
input vocopt
|
|
if upcase(vocopt) = "A" then close vocfile ; goto MAINLOOP
|
|
if upcase(vocopt) = "N" then
|
|
svoc4:
|
|
print "New name? ":
|
|
input subarg
|
|
if subarg = "" then close vocfile ; goto MAINLOOP
|
|
goto svoc1
|
|
end
|
|
if upcase(vocopt) ne "O" then goto svoc2
|
|
svoc3:
|
|
vocsent = 0
|
|
authvar = @AUTHORIZATION
|
|
vocsent<1> = "S Saved at ":timedate():" by ":authvar
|
|
vocsent<2> = sqlsave:";"
|
|
write vocsent to vocfile,subarg then
|
|
print 'Item "':subarg:'" saved in your VOC'
|
|
end
|
|
else print 'Unable to write to file "VOC"'
|
|
close vocfile
|
|
goto MAINLOOP
|
|
|
|
* Set edit mode to enable or disable the use of cursor control keys
|
|
SETEDMODE:
|
|
print "EDITKEYS not yet implemented" ; *****************************To be done
|
|
cmdstatus = 2
|
|
return
|
|
|
|
* Set column width for one or all columns, or set data-truncation mode
|
|
SETWIDTH:
|
|
if dcount(subarg,",") ne 2 then
|
|
if upcase(subarg) = "T" then truncdata = 1 ; goto endsetw
|
|
if upcase(subarg) = "F" then truncdata = 0 ; goto endsetw
|
|
if subarg = "?" then goto printwidths
|
|
print "Width argument must be T, F, ?, or contain exactly one comma"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
arg1 = field(subarg,",",1)
|
|
arg2 = field(subarg,",",2)
|
|
if arg1 = "*" then goto ckarg2
|
|
if num(arg1) ne 1 or dcount(arg1,".") > 1 then
|
|
print "First part of width argument must be an asterisk or a number"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
if arg1 > MAX.COLS or arg1 < 1 then
|
|
mxcl = MAX.COLS
|
|
print "Column number must be between 1 and ":mxcl
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
ckarg2:
|
|
if num(arg2) ne 1 or dcount(arg2,".") > 1 then
|
|
print "Second part of width argument must be a number"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
if arg2 > linelen or arg2 < MIN.WIDTH then
|
|
mwid = MIN.WIDTH
|
|
print "Column width must be between ":mwid:" and ":linelen
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
if arg1 ne "*" then widths(arg1) = arg2 else
|
|
defwidth = arg2
|
|
for i = 1 to MAX.COLS
|
|
widths(i) = "*"
|
|
next i
|
|
end
|
|
endsetw:
|
|
cmdstatus = 0
|
|
return
|
|
printwidths:
|
|
print "Truncate/Fold mode is:":space(9):
|
|
if truncdata then print " T" else print " F"
|
|
wpflag = 0
|
|
for i = 1 to MAX.COLS
|
|
if widths(i) ne "*" then
|
|
if wpflag = 0 then print "Column width settings are:"
|
|
wpflag = 1
|
|
print space(20):
|
|
print "Column ":i:": ":
|
|
if i < 10 then print " ":
|
|
if widths(i) < 10 then print " ":
|
|
print widths(i)
|
|
end
|
|
next i
|
|
if wpflag then print space(12):"All other columns:": else
|
|
print "All column width settings are:":
|
|
end
|
|
if defwidth > 9 then print " ": else print " ":
|
|
print defwidth
|
|
goto endsetw
|
|
|
|
* Set NULL-character display
|
|
SETNULL:
|
|
if upcase(subarg) = "NOCONV" then nullvar = "" else
|
|
if upcase(subarg) = "SPACE" then nullvar = " " else
|
|
if len(subarg) > MIN.WIDTH then
|
|
mwid = MIN.WIDTH
|
|
print "NULL-character display must be ":
|
|
print mwid:" or fewer characters"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
nullvar = subarg
|
|
end
|
|
end
|
|
cmdstatus = 0
|
|
return
|
|
|
|
* Set value mark display character
|
|
SETVM:
|
|
if upcase(subarg) = "NOCONV" then vmprint = @VM else
|
|
if upcase(subarg) = "SPACE" then vmprint = " " else
|
|
if len(subarg) > 1 then
|
|
print "Value mark character display must be ":
|
|
print 1:" or fewer characters"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
vmprint = subarg
|
|
end
|
|
end
|
|
cmdstatus = 0
|
|
return
|
|
|
|
* Set key mapping for editing a recalled statement
|
|
SETKEY:
|
|
print "SETKEY not yet implemented" ; ********************************To be done
|
|
cmdstatus = 2
|
|
return
|
|
|
|
* Set prefix character for local commands
|
|
SETPREFIX:
|
|
if len(subarg) ne 1 then
|
|
print "Prefix must be exactly one character"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
delim = subarg
|
|
if ((delim ge "!" and delim le "/") or delim = ":" or delim = "=" or delim = "?" or delim = "@" or (delim ge "[" and delim le "]") or delim = "`" or (delim ge "{" and delim le "}")) then
|
|
prefix = subarg
|
|
cmdstatus = 0
|
|
return
|
|
end
|
|
else
|
|
print '"':subarg:'" is not a valid prefix character'
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
|
|
* Set up uniVerse file for storing output of a SELECT (or cancel this mode)
|
|
* If a previous file was open, close it first
|
|
UVOUT:
|
|
if uvopen then
|
|
print "Closing file ":uvfile
|
|
close tempfile
|
|
uvopen = 0
|
|
end
|
|
if upcase(subarg) = "OFF" then uvfile = "" ; cmdstatus = 0 ; return
|
|
uvfile = subarg
|
|
open uvfile to tempfile else
|
|
* Future consideration: Create a table (not a file) if in a schema?******
|
|
* Determine type of CREATE.FILE syntax to use
|
|
flavor = system(1001)
|
|
if (flavor = 2 or flavor = 8 or flavor = 16) then
|
|
cfcmd = "CREATE.FILE ":uvfile:" 1,2,3 1,1,30"
|
|
end else
|
|
cfcmd = "CREATE.FILE ":uvfile:" 30"
|
|
end
|
|
perform cfcmd
|
|
open uvfile to tempfile else
|
|
print "Can't open ":uvfile
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
end
|
|
open "DICT", uvfile to tempdict else
|
|
close tempfile
|
|
print "Can't open DICT ":uvfile
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
print "Opening file ":uvfile
|
|
uvopen = 1
|
|
cmdstatus = 0
|
|
selcmd = ""
|
|
return
|
|
|
|
* Set debug mode on or off
|
|
SETDEBUG:
|
|
if upcase(subarg) = "OFF" then debug = 0 else
|
|
if upcase(subarg) = "ON" then debug = 1 else
|
|
print "Debug mode must be set to ON or OFF"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
end
|
|
cmdstatus = 0
|
|
return
|
|
|
|
* Set verbose mode on or off
|
|
SETVERBOSE:
|
|
if upcase(subarg) = "OFF" then verbose = 0 else
|
|
if upcase(subarg) = "ON" then verbose = 1 else
|
|
print "Verbose mode must be set to ON or OFF"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
end
|
|
cmdstatus = 0
|
|
return
|
|
|
|
* Set block mode on or off, or on with a specific termination line 'blockstr'.
|
|
* Block mode disables the semi-colon terminator when inputting SQL statements;
|
|
* this is useful for inputting Oracle PL/SQL blocks.
|
|
SETBLOCK:
|
|
begin case
|
|
case upcase(subarg) = "OFF"
|
|
blockmode = 0 ; cmdstatus = 0 ; return
|
|
case upcase(subarg) = "ON"
|
|
blockmode = 1 ; blockstr = "" ; cmdstatus = 0 ; return
|
|
case len(subarg) le 4
|
|
blockmode = 1 ; blockstr = upcase(subarg) ; cmdstatus = 0 ; return
|
|
end case
|
|
print "Block mode must be ON, OFF, or a string of 4 or fewer characters"
|
|
cmdstatus = 3
|
|
return
|
|
|
|
* Get and store original PTERM input-case-inversion parameters
|
|
GPTERM:
|
|
ttyget ttycase else stop "Can't do TTYGET"
|
|
ucinstore = ttycase<4,1>
|
|
invstore = ttycase<4,4>
|
|
return
|
|
|
|
* Restore original PTERM parameters for input-case-inversion
|
|
RPTERM:
|
|
subarg = "INIT"
|
|
gosub SETINVERT
|
|
return
|
|
|
|
* Set input-case-inversion to OFF (-UCIN, -INVERT), to ON (-UCIN, INVERT),
|
|
* or to the original value that was in effect when CONNECT was invoked.
|
|
SETINVERT:
|
|
ttyget ttycase else
|
|
print "Can't do TTYGET"
|
|
cmdstatus = 3
|
|
return
|
|
end
|
|
begin case
|
|
case upcase(subarg) = "OFF"
|
|
ttycase<4,1> = 0
|
|
ttycase<4,4> = 0
|
|
ttyset ttycase else
|
|
print "Can't do TTYSET"
|
|
cmdstatus = 3
|
|
end
|
|
return
|
|
case upcase(subarg) = "ON"
|
|
ttycase<4,1> = 0
|
|
ttycase<4,4> = 1
|
|
ttyset ttycase else
|
|
print "Can't do TTYSET"
|
|
cmdstatus = 3
|
|
end
|
|
return
|
|
case upcase(subarg) = "INIT" or upcase(subarg) = "INITIAL"
|
|
ttycase<4,1> = ucinstore
|
|
ttycase<4,4> = invstore
|
|
ttyset ttycase else
|
|
print "Can't do TTYSET"
|
|
cmdstatus = 3
|
|
end
|
|
return
|
|
end case
|
|
print "Input-case-inversion must be set to ON, OFF, or INIT"
|
|
cmdstatus = 3
|
|
return
|
|
|
|
* Display information about all available data sources
|
|
SHOWSERVERS:
|
|
prcomment = 0 ; ******************************* was set to 1 during testing ****
|
|
debug = 0 ; ************************************was set to 1 during testing ****
|
|
* Allocate an array to keep already-defined Data Source names
|
|
dim dsdefs(MAX.DS.DEFS,3)
|
|
gosub findconf
|
|
endmsg = "**The configuration file has no [ODBC DATA SOURCES] line"
|
|
gosub findodbc
|
|
endmsg = "**The configuration file contains no Data Source specifications"
|
|
gotconf:
|
|
print ""
|
|
print "Data Source information from ":path:"/uv":
|
|
if conffound = 2 then print ".":
|
|
print "odbc.config:"
|
|
print ""
|
|
dscount = 0
|
|
gosub get1
|
|
findds:
|
|
odbctype = 0
|
|
dsnotdone = 0
|
|
if confline[1,1] = "<" then
|
|
if dscount ge MAX.DS.DEFS then
|
|
closeseq conffile
|
|
mxds = MAX.DS.DEFS
|
|
print "**Too many (>":mxds:") Data Source specifications":
|
|
stop " in configuration file"
|
|
end
|
|
badds = 0
|
|
if confline[1] ne ">" then
|
|
dsource = trim(confline[2,len(confline)-1])
|
|
print "Data Source: ":dsource
|
|
print '**Data Source name has no terminating ">"'
|
|
badds = 1
|
|
goto chkblank
|
|
end
|
|
dsource = trim(confline[2,len(confline)-2])
|
|
print "Data Source: ":dsource
|
|
chkblank:
|
|
if dsource = "" or dsource = " " then
|
|
dsource = " "
|
|
print "**Data Source name is blank"
|
|
badds = 1
|
|
goto storeds
|
|
end
|
|
if dscount = 0 then goto storeds
|
|
for i = 1 to dscount
|
|
if dsource = dsdefs(i,1) then
|
|
print "**Duplicate Data Source name: ":dsource
|
|
badds = 1
|
|
goto storeds
|
|
end
|
|
next
|
|
storeds:
|
|
dscount = dscount + 1
|
|
dbtype = "??????"
|
|
nettype = "??????"
|
|
hostsys = "??????"
|
|
service = "??????"
|
|
dsdefs(dscount,1) = dsource
|
|
dsdefs(dscount,2) = hostsys
|
|
dsdefs(dscount,3) = service
|
|
dsnotdone = 1
|
|
hostdone = 0
|
|
servdone = 0
|
|
gosub get1
|
|
if confline[1,1] = "<" or confline[1,1] = "[" then goto shortds
|
|
if upcase(trim(field(confline,"=",1))) ne "DBMSTYPE" then
|
|
print "**DBMS Type not found on first line after Data Source name"
|
|
print "****Found instead: ":confline
|
|
badds = 1
|
|
goto getnet
|
|
end
|
|
dbtype = upcase(trim(field(confline,"=",2)))
|
|
if dbtype = "" or dbtype = " " then
|
|
print "**DBMS Type is blank"
|
|
badds = 1
|
|
end
|
|
if dbtype="ODBC" then odbctype = 1
|
|
getnet:
|
|
gosub get1
|
|
if confline[1,1] = "<" or confline[1,1] = "[" then goto shortds
|
|
if upcase(trim(field(confline,"=",1))) ne "NETWORK" then
|
|
if odbctype = 0
|
|
then
|
|
print "**Network Type not found on 2nd line after Data Source name"
|
|
print "****Found instead: ":confline
|
|
end
|
|
badds = 1
|
|
goto getpart
|
|
end
|
|
nettype = upcase(trim(field(confline,"=",2)))
|
|
if nettype = "" or nettype = " " then
|
|
print "**Network Type is blank"
|
|
badds = 1
|
|
goto getpart
|
|
end
|
|
if nettype ne "TCP/IP" and nettype ne "LAN" then
|
|
print "**":nettype:" is not a currently supported Network Type"
|
|
badds = 1
|
|
end
|
|
getpart:
|
|
gosub get1
|
|
if confline[1,1] = "<" or confline[1,1] = "[" then
|
|
if (hostdone and servdone) then goto endds else goto shortds
|
|
end
|
|
if upcase(trim(field(confline,"=",1))) = "HOST" then
|
|
if hostdone then
|
|
print "**Host System ":
|
|
goto dupdef
|
|
end
|
|
hostname = trim(field(confline,"=",2))
|
|
if hostname = "" or hostname = " " then
|
|
print "**Host System definition is blank"
|
|
badds = 1
|
|
hostsys = " "
|
|
goto endhost
|
|
end
|
|
|
|
******************
|
|
** Windows NT port
|
|
**
|
|
if OS.TYPE = "MSWIN" then
|
|
|
|
etcip = ""
|
|
hostsys = hostname
|
|
dsdefs(dscount,2) = hostname
|
|
|
|
end
|
|
else
|
|
if nettype = "TCP/IP" then
|
|
grepcmd = "grep ":hostname:" /etc/hosts"
|
|
execute 'SH -c "':grepcmd:'"' capturing etcall
|
|
ecount = dcount(etcall,@FM)
|
|
if ecount <= 1 then ecount = ecount + 1
|
|
lcount = 0
|
|
loopetc:
|
|
lcount = lcount + 1
|
|
if lcount ge ecount then goto notinetc
|
|
etchosts = field(field(etcall,@FM,lcount),"#",1)
|
|
etchosts = trim(change(etchosts,CHAR(9)," ",-1))
|
|
if dcount(etchosts," ") le 1 then goto loopetc
|
|
etcip = field(etchosts," ",1)
|
|
if dcount(etcip,".") ne 4 then goto loopetc
|
|
if not(num(field(etcip,".",1,2))) then goto loopetc
|
|
if not(num(field(etcip,".",3,4))) then goto loopetc
|
|
if hostname = etcip then
|
|
hostname = field(etchosts," ",2)
|
|
goto endtcphost
|
|
end
|
|
etchosts = convert(" ",@FM,etchosts)
|
|
find hostname in etchosts setting fmv else goto loopetc
|
|
endtcphost:
|
|
if len(hostname) le 2 then hostname = hostname:CHAR(9)
|
|
hostsys = hostname:CHAR(9):etcip
|
|
dsdefs(dscount,2) = etcip
|
|
goto endhost
|
|
end
|
|
else
|
|
hostsys = hostname
|
|
dsdefs(dscount,2) = hostname
|
|
end
|
|
|
|
end ; * OS.TYPE = "MSWIN"
|
|
**
|
|
******************
|
|
|
|
endhost:
|
|
hostdone = 1
|
|
goto getpart
|
|
end
|
|
|
|
if upcase(trim(field(confline,"=",1))) = "SERVICE" then
|
|
if servdone then
|
|
print "**Service Name ":
|
|
goto dupdef
|
|
end
|
|
service = trim(field(confline,"=",2))
|
|
if service = "" or service = " " then
|
|
print "**Service Name is blank"
|
|
service = " "
|
|
badds = 1
|
|
end
|
|
else
|
|
dsdefs(dscount,3) = service
|
|
end
|
|
servdone = 1
|
|
goto getpart
|
|
end
|
|
if upcase(trim(field(confline,"=",1))) = "DBMSTYPE" then
|
|
print "**DBMS Type ":
|
|
goto dupdef
|
|
end
|
|
if upcase(trim(field(confline,"=",1))) = "NETWORK" then
|
|
print "**Network Type ":
|
|
goto dupdef
|
|
end
|
|
goto getpart
|
|
end
|
|
gosub get1
|
|
goto findds
|
|
|
|
notinetc:
|
|
print "**Note: Host System '":hostname: ; * changed 12/20/93
|
|
print "' doesn't appear in /etc/hosts"
|
|
hostsys = hostname
|
|
* badds = 1 ; * commented out 12/20/93
|
|
goto endhost
|
|
|
|
shortds:
|
|
badds = 1
|
|
gosub printds
|
|
goto findds
|
|
|
|
endds:
|
|
gosub printds
|
|
goto findds
|
|
|
|
dupdef:
|
|
badds = 1
|
|
print "is multiply-defined; first definition is shown below"
|
|
goto getpart
|
|
|
|
* Verify that config file exists, has proper start line, defines specific
|
|
* data source, and has dbmstype for that data source
|
|
VERIFYDS:
|
|
debug = 0 ; ************************************ was set to 1 during testing
|
|
prcomment = 0 ; ******************************** was set to 1 during testing
|
|
gosub findconf
|
|
endmsg = "The configuration file has no [ODBC DATA SOURCES] line"
|
|
gosub findodbc
|
|
endmsg = "Data Source '":server:"' not found in configuration file"
|
|
dscount = 0
|
|
countds = 0
|
|
findspecific:
|
|
gosub get1
|
|
if confline[1,1] = "<" then
|
|
if confline[1] = ">" then conflen = len(confline) - 2
|
|
else conflen = len(confline) - 1
|
|
if trim(confline[2,conflen]) = server then goto findspecdb
|
|
countds = countds + 1
|
|
if countds ge MAX.DS.DEFS then
|
|
closeseq conffile
|
|
mxds = MAX.DS.DEFS
|
|
print "Too many (":mxds:
|
|
stop ") Data Source specifications in configuration file"
|
|
end
|
|
end
|
|
goto findspecific
|
|
findspecdb:
|
|
odbctype = 0
|
|
endmsg = "Data Source '":server:"' has no DBMSTYPE in configuration file"
|
|
gosub get1
|
|
if upcase(trim(field(confline,"=",1))) ne "DBMSTYPE" then stop endmsg
|
|
dbtype = upcase(trim(field(confline,"=",2)))
|
|
if dbtype = "ODBC" then odbctype = 1
|
|
if (dbtype = "" or dbtype = " ") then stop endmsg
|
|
localhost = 0
|
|
endmsg = "Data Source '":server:"' has no HOST in configuration file"
|
|
if odbctype = 0
|
|
then
|
|
loop
|
|
gosub get1
|
|
if confline[1,1] = "<" or confline[1,1] = "[" then
|
|
closeseq conffile
|
|
stop endmsg
|
|
end
|
|
until upcase(trim(field(confline,"=",1))) = "HOST"
|
|
repeat
|
|
end
|
|
closeseq conffile
|
|
hostname = trim(field(confline,"=",2))
|
|
if (hostname = "" or hostname = " ") and odbctype = 0 then stop endmsg
|
|
if (hostname = "localhost" or hostname = "127.0.0.1") then localhost = 1
|
|
return ; ** return from VERIFYDS
|
|
|
|
* Look for uvodbc.config (or uv.odbc.config) file in current directory,
|
|
* then uvhome, then /etc
|
|
* If found, return; else stop with error
|
|
findconf:
|
|
conffound = 0
|
|
|
|
******************
|
|
** Windows NT port
|
|
**
|
|
if OS.TYPE = "MSWIN" then
|
|
|
|
path = @PATH
|
|
gosub oseq
|
|
if conffound then return
|
|
path = SYSTEM(32)
|
|
gosub oseq
|
|
if conffound then return
|
|
stop "Can't find configuration file"
|
|
|
|
end
|
|
else
|
|
|
|
execute 'SH -c "pwd"' capturing path
|
|
path = path[1,len(path)-1]
|
|
gosub oseq
|
|
if conffound then return
|
|
execute 'SH -c "cat /.uvhome"' capturing path
|
|
path = path[1,len(path)-1]
|
|
gosub oseq
|
|
if conffound then return
|
|
path = "/etc"
|
|
gosub oseq
|
|
if conffound then return
|
|
stop "Can't find configuration file"
|
|
|
|
end ; * OS.TYPE = "MSWIN"
|
|
**
|
|
******************
|
|
|
|
oseq:
|
|
scount=0
|
|
oseq1:
|
|
if scount > LOCK.SLEEP then stop "configuration file is locked"
|
|
openseq path:"/uvodbc.config" to conffile locked
|
|
sleep 2
|
|
scount = scount+1
|
|
goto oseq1
|
|
end
|
|
then
|
|
conffound = 1
|
|
return
|
|
end else
|
|
scount=0
|
|
oseq2:
|
|
if scount > LOCK.SLEEP then stop "configuration file is locked"
|
|
openseq path:"/uv.odbc.config" to conffile locked
|
|
sleep 2
|
|
scount = scount+1
|
|
goto oseq2
|
|
end then
|
|
conffound = 2
|
|
return
|
|
end
|
|
end
|
|
return
|
|
|
|
findodbc:
|
|
gosub get1
|
|
if confline[1,1] = "[" then
|
|
if confline[1] = "]" then conflen = len(confline) - 2
|
|
else conflen = len(confline) - 1
|
|
if upcase(trim(confline[2,conflen])) = "ODBC DATA SOURCES" then return
|
|
end
|
|
goto findodbc
|
|
|
|
get1:
|
|
readseq confline from conffile else goto chkstat
|
|
|
|
******************
|
|
** Windows NT port
|
|
**
|
|
if OS.TYPE = "MSWIN" then
|
|
|
|
if len(confline) and confline[1] = char(13) then
|
|
confline = confline[1, len(confline) - 1]
|
|
end
|
|
|
|
end ; * OS.TYPE = "MSWIN"
|
|
**
|
|
******************
|
|
|
|
if prcomment and confline[1,4] = "[*[*" then print confline
|
|
if status() ne 0 then goto chkstat
|
|
* Convert tabs to spaces, remove redundant spaces, and test for blank line
|
|
confline = trim(change(confline[1,999],CHAR(9)," ",-1))
|
|
if confline = "" or confline = " " then goto get1 else return
|
|
|
|
chkstat:
|
|
closeseq conffile
|
|
if status() ne 1 then print "Can't read configuration file"
|
|
if dscount = 0 then
|
|
stop endmsg
|
|
end
|
|
if (dsnotdone and not(hostdone and servdone)) then badds = 1
|
|
if dsnotdone then gosub printds
|
|
stop
|
|
|
|
printds:
|
|
if dscount le 1 then goto printds1
|
|
if dsdefs(dscount,2) = "??????" then goto printds1
|
|
if dsdefs(dscount,3) = "??????" then goto printds1
|
|
for i = 1 to dscount - 1
|
|
if service = dsdefs(i,3) then
|
|
if nettype = "TCP/IP" then
|
|
if etcip = dsdefs(i,2) then goto printds2
|
|
end
|
|
else
|
|
if hostname = dsdefs(i,2) then goto printds2
|
|
end
|
|
end
|
|
next
|
|
printds1:
|
|
print " DBMS Type: ":dbtype
|
|
if odbctype = 0
|
|
then
|
|
print " Network Type: ":nettype
|
|
print " Host System: ":hostsys
|
|
print " Service Name: ":service
|
|
if badds then print "**This Data Source specification is incomplete or otherwise invalid"
|
|
end
|
|
print ""
|
|
dsnotdone = 0
|
|
return
|
|
printds2:
|
|
* 11/18/93 Following message was commented out because it confused some people
|
|
* print "**Warning: This definition (host, service) duplicates Data Source '":
|
|
* print dsdefs(i,1):"'"
|
|
* 11/18/93 Here's another possibility; is this less confusing?
|
|
* print "**Note: This Data Source defines the same Host and Service as '":
|
|
* print dsdefs(i,1):"'"
|
|
goto printds1
|
|
|
|
end
|