****************************************************************************** * * 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 = 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