The SQL Terminal Monitor Application
This application executes SQL statements that are read in from the terminal. The application reads statements from input and writes results to output. Dynamic SQL is used to process and execute the statements.
When the application starts, it prompts the user for the database name. The program then prompts for an SQL statement. Each SQL statement can continue over multiple lines, and must end with a semicolon. No SQL comments are accepted. The SQL statement is processed using Dynamic SQL, and results and SQL errors are written to output. At the end of the results, the program displays an indicator of the number of rows affected. The loop is then continued and the program prompts the user for another SQL statement. When the user types in end-of-file, the application rolls back any pending updates and disconnects from the database.
The user's SQL statement is prepared using prepare and describe. If the SQL statement is not a select statement, then it is run using execute and the number of rows affected is printed. If the SQL statement is a select statement, a Dynamic SQL cursor is opened, and all the rows are fetched and printed. The routines that print the results do not try to tabulate the results. A row of column names is printed, followed by each row of the results.
Keyboard interrupts are not handled. Fatal errors, such as allocation errors, and boundary condition violations are handled by rolling back pending updates and disconnecting from the database session.
Note: Use your system function to obtain the address.
The application runs in UNIX, VMS, and Windows environments.
C
C Program: SQL_Monitor
C Purpose: Main entry of SQL Monitor application. Prompt for
C database name and connect to the database. Run the
C monitor and disconnect from the database. Before
C disconnecting roll back any pending updates.
C
C UNIX compiler will generate - "Warning: %LOC function
C treated as LOC."
C This is for compatibility with VMS. Just ignore the
C message or change %LOC to LOC.
C
program SQL_Monitor
exec sql include sqlca
exec sql begin declare section
character*50 dbname
exec sql end declare section
C Prompt for database name.
write (*, 50)
50 format (' SQL Database: ', $)
read (*, 51, err = 59, end = 59) dbname
51 format (A)
print *, ' -- SQL Terminal Monitor --'
C Treat connection errors as fatal.
exec sql whenever sqlerror stop
exec sql connect :dbname
call Run_Monitor()
exec sql whenever sqlerror continue
print *, 'SQL: Exiting monitor program.'
exec sql rollback
exec sql disconnect
59 end
C
C Subroutine:Run_Monitor
C Purpose: Run the SQL monitor. Initialize the global SQLDA with
C the number of SQLVAR elements. Loop while prompting
C the user for input; if end-of-file is detected then
C return to the main program.
C
C If the statement is not a SELECT statement then
C EXECUTE it, otherwise open a cursor a process a
C dynamic SELECT statement (using Execute_Select).
C
subroutine Run_Monitor
C Declare the SQLCA and the SQLDA structure definition
exec sql include sqlca
exec sql include sqlda
exec sql begin declare section
character*1000 stmt_buf
exec sql end declare section
record /IISQLDA/ sqlda
common /sqlda_area/ sqlda
integer stmt_num
integer rows
logical Read_Stmt
integer Execute_Select
exec sql declare stmt statement
C Initialize the SQLDA
sqlda.sqln = IISQ_MAX_COLS
C Now we are set for input
stmt_num = 0
do while (.TRUE.)
stmt_num = stmt_num + 1
C
C Prompt and read the next statement. If Read_Stmt
C returns FALSE then end-of-file was detected.
C
if (.not. Read_Stmt(stmt_num, stmt_buf)) return
C Handle database errors.
exec sql whenever sqlerror goto 62
C
C Prepare and describe the statement. If the statement is not
C a SELECT then EXECUTE it, otherwise inspect the contents of
C the SQLDA and call Execute_Select.
C
exec sql prepare stmt from :stmt_buf
exec sql describe stmt into :sqlda
C If SQLD = 0 then this is not a SELECT.
if (sqlda.sqld .eq. 0) then
exec sql execute stmt
rows = sqlerr(3)
else
C Are there enough result variables
if (sqlda.sqld .le. sqlda.sqln) then
rows = Execute_Select()
else
write(*, 60) sqlda.sqld, sqlda.sqln
60 format (' SQL Error: SQLDA requires ', I3,
1 ' variables, but has only ', I3 '.')
rows = 0
end if
end if
C Print number of rows processed.
write (*, 61) rows
61 format (' [', I6, ' row(s)]')
exec sql whenever sqlerror continue
C If we got here because of an error then print the error
C message.
62 if (sqlcod .lt. 0) call Print_Error()
end do
return
end
C
C Function: Execute_Select
C Purpose: In a dynamic SELECT statement. The SQLDA has already
C been described, so print the column header (names),
C open a cursor and retrieve and print the results.
C Accumulate the number of rows processed.
C Parameters:
C None
C Returns:
C Number of rows processed.
C
integer function Execute_Select()
exec sql include sqlca
exec sql include sqlda
record /IISQLDA/ sqlda
common /sqlda_area/ sqlda
integerrows
logical Print_Header
exec sql declare csr cursor for stmt
C
C Print result column names, set up the result types and
C variables. Print_Header returns FALSE if the dynamic
C set-up failed.
C
if (.not. Print_Header()) then
Execute_Select = 0
return
end if
exec sql whenever sqlerror goto 70
C Open the dynamic cursor.
exec sql open csr for readonly
C Fetch and print each row.
rows = 0
do while (sqlcod .eq. 0)
exec sql fetch csr using descriptor :sqlda
if (sqlcod .eq. 0) then
rows = rows + 1
call Print_Row()
end if
end do
C If we got here because of an error then print the error
C message.
70 if (sqlcod .lt. 0) call Print_Error()
exec sql whenever sqlerror continue
exec sql close csr
Execute_Select = rows
return
end
C
C Function: Print_Header
C Purpose: A statement has just been described so set up the SQLDA
C for result processing. Print all the column names and
C allocate result variables for retrieving data. The
C result variables are chosen out of a pool of variables
C (integers, floats and a large character string space).
C The SQLDATA and SQLIND fields are pointed at the
C addresses of the result variables.
C Returns:
C TRUE if successfully set up the SQLDA for
C result variables,
C FALSE if an error occurred.
C
logical function Print_Header ()
exec sql include sqlda
record /IISQLDA/ sqlda
common /sqlda_area/ sqlda
C User defined handler for large objects
external UsrDataHandler
integer UsrDataHandler
C Limit the size of a large object
C If you increase BLOB_MAX than increase hdlarg.argstr
C and 'segbuf'
parameter (BLOB_MAX = 50)
record /IISQLHDLR/ datahdlr(IISQ_MAX_COLS)
C Global result data storage
structure /hdlr_arg/
character*50 argstr
integer arglen
end structure
record /hdlr_arg/ hdlarg(IISQ_MAX_COLS)
integer*4 integers(IISQ_MAX_COLS)
real*8 reals(IISQ_MAX_COLS)
integer*2 inds(IISQ_MAX_COLS)
character*2500 characters
character*3000 disp_results
common /result_area/ integers, reals, inds, characters,
1 disp_results
integer cl
integer clc
integer dl
character*2000 names
integer nl
integer nlc
integer i
integer base_type
logical is_null
C
C Add the name and number of each column into a column name buffer.
C Display this buffer as a header when done with all the columns.
C While processing each column determine the type of the column
C and to where SQLDATA must point in order to retrieve compatible
C results.
C
cl = 1
nl = 1
dl = 0
do 85, i = 1, sqlda.sqld
C
C Fill up the names buffer. If it overflows print an error and
C return that we failed.
C
if (nl .gt. (len(names) - 40)) then
print *, 'SQL Error: Result column name overflow.'
Print_Header = .false.
return
end if
C
C Store column title in the form "[column #] column_name "
C For example, the employee table may look like:
C [1] name [ 2] age [ 3] salary [ 4] dept
C
write (names(nl:),80)i
80 format ('[', I3, '] ')
nl = nl + 6
nlc = sqlda.sqlvar(i).sqlname.sqlnamel
names(nl:nl+nlc) = sqlda.sqlvar(i).sqlname.sqlnamec(1:nlc)
nl = nl + nlc
names(nl:nl) = ' '
nl = nl + 1
C
C At this point we've stored away the column name. Now we
C process the column for type and length information. Use the
C global numeric array and the large character buffer from which
C pieces can be allocated.
C
C Also accumulate the length of the display buffer that we will
C need later to print the results - they will all be converted
C into character data in the display buffer. Make sure that
C the default field widths of the different types will fit into
C the buffer 'disp_results'. For example, the display buffer for
C a single row of the employee table may look like:
C [ 1] mark [ 2] 36 [ 3] 52000.0 [ 4] eng
C
dl = dl + 7
C Find the base-type of the result (non-nullable).
if (sqlda.sqlvar(i).sqltype .gt. 0) then
base_type = sqlda.sqlvar(i).sqltype
is_null = .false.
else
base_type = -sqlda.sqlvar(i).sqltype
is_null = .true.
end if
C
C Collapse all different types into one of INTEGER, REAL
C or CHARACTER. Accumulate the number of characters required
C from the display buffer (use default format lengths).
C
if (base_type .eq. IISQ_INT_TYPE) then
sqlda.sqlvar(i).sqltype = IISQ_INT_TYPE
sqlda.sqlvar(i).sqllen = 4
sqlda.sqlvar(i).sqldata = %loc(integers(i))
dl = dl + 12
else if ((base_type .eq. IISQ_FLT_TYPE) .or.
1 (base_type .eq. IISQ_DEC_TYPE) .or.
2 (base_type .eq. IISQ_MNY_TYPE)) then
sqlda.sqlvar(i).sqltype = IISQ_FLT_TYPE
sqlda.sqlvar(i).sqllen = 8
sqlda.sqlvar(i).sqldata = %loc(reals(i))
dl = dl + 25
else if ((base_type .eq. IISQ_CHA_TYPE) .or.
1 (base_type .eq. IISQ_VCH_TYPE) .or.
2 (base_type .eq. IISQ_DTE_TYPE)) then
C
C Determine the length of the sub-string required from the
C the large character array. If we have enough space left
C then point at the start of the corresponding substring,
C otherwise print an error and return.
C
if (base_type .eq. IISQ_DTE_TYPE) then
clc = 25
else
clc = sqlda.sqlvar(i).sqllen
end if
if ((cl + clc) .gt. len(characters)) then
write (*, 81) cl+clc
81 format (' SQL Error: Character result data overflow. '
1 'Need ', I4, ' bytes.')
Print_Header = .false.
return
end if
C Grab space out of the large character buffer
sqlda.sqlvar(i).sqltype = IISQ_CHA_TYPE
sqlda.sqlvar(i).sqllen = clc
sqlda.sqlvar(i).sqldata = %loc(characters(cl:))
cl = cl + clc
dl = dl + clc
else if (base_type .eq. IISQ_LVCH_TYPE) then
C
C Long varchar, so use datahandler. Use Blob Max to limit the
C length of the Blob sub-string returned/displayed.
C
sqlda.sqlvar(i).sqltype = IISQ_HDLR_TYPE
sqlda.sqlvar(i).sqllen = BLOB_MAX
sqlda.sqlvar(i).sqldata = %loc(datahdlr(i))
datahdlr(i).sqlhdlr = %loc(UserDataHandler)
datahdlr(i).sqlarg = %loc(hdlrag(i))
hdlarg(i).arglen = BLOB_MAX
d1 = d1 + BLOB_MAX
end if
C Remember to save the null indicator
if (is_null) then
sqlda.sqlvar(i).sqltype = -sqlda.sqlvar(i).sqltype
sqlda.sqlvar(i).sqlind = %loc(inds(i))
else
sqlda.sqlvar(i).sqlind = 0
end if
85 continue
C
C Print all the saved column names. This loop does not use any
C special formats, but just breaks the line at column 75.
C
nl = nl - 1
do 88 i = 1, nl , 75
write (*, 87) names(i:min(i+74,nl))
87 format (' ', A)
88 continue
print *, '--------------------------------'
C
C Confirm that the character representation of the results
C will fit inside the display buffer.
C
if (dl .gt. len(disp_results)) then
write (*, 81) dl
89 format (' SQL Error: Result display buffer overflow. '
1 'Need ', I4, ' bytes.')
Print_Header = .false.
return
end if
Print_Header = .true.
return
end
C
C Procedure:Print_Row
C Purpose: For each element inside the SQLDA, print the value.
C Print its column number too in order to identify it
C with a column name printed earlier in Print_Header. If
C the value is NULL print "N/A".
C Parameters:
C None
C
subroutine Print_Row
exec sql include sqlda
record /IISQLDA/ sqlda
common /sqlda_area/ sqlda
C Global result data storage
structure /hdlr_arg/
character*50 argstr
integer arglen
end structure
record /hdlr_arg/ hdlarg(IISQ_MAX_COLS)
integer*4 integers(IISQ_MAX_COLS)
real*8 reals(IISQ_MAX_COLS)
integer*2 inds(IISQ_MAX_COLS)
character*2500 characters
character*3000 disp_results
common /result_area/ integers, reals, inds, characters,
1 disp_results, hdlarg
integer cl
integer clc
integer dl
integer i
integer base_type
logical is_null
C
C For each column, print the column number and the data.
C NULL columns print as "N/A". The printing is done by
C encoding the complete row into a display buffer (that is
C already guaranteed to be able to contain the whole row),
C and then displaying the data at the end of the row.
C
cl = 1
dl = 1
do 95, i = 1, sqlda.sqld
C Store result column number in the form "[ # ]"
write(disp_results(dl:),90)i
90 format ('[', I3, '] ')
dl = dl + 6
C Find the base-type of the result (non-nullable)
if (sqlda.sqlvar(i).sqltype .gt. 0) then
base_type = sqlda.sqlvar(i).sqltype
is_null = .false.
else
base_type = -sqlda.sqlvar(i).sqltype
is_null = .true.
end if
C
C Collapse different types into INTEGER, REAL or CHARACTER.
C If the data is NULL then just print "N/A".
C
if (is_null .and. (inds(i) .eq. -1)) then
disp_results(dl:dl+2) = 'N/A'
dl = dl + 3
else if (base_type .eq. IISQ_INT_TYPE) then
write(disp_results(dl:),91)i
91 format (I)
dl = dl + 12
else if (base_type .eq. IISQ_FLT_TYPE) then
write(disp_results(dl:),92)i
92 format (G)
dl = dl + 25
else if (base_type .eq. IISQ_CHA_TYPE) then
C Use the characters out of the large character buffer
clc = sqlda.sqlvar(i).sqllen
disp_results(dl:dl+clc-1) = characters(cl:)
dl = dl + clc
cl = cl + clc
else if (base_type .eq. IISQ_HDLR_TYPE) then
C Use the argstr out of the handler structure buffer
clc = sqlda.sqlvar(i).sqllen
disp_results(d1:d1+clc-1) = hdlarg(i).argstr
dl = dl + clc
end if
disp_results(dl:dl) = ' '
dl = dl + 1
95 continue
!
! Print the result data. This loop does not use any special
! formats, but just breaks the line at column 75.
!
dl = dl - 1
do 98 i = 1, dl , 75
write (*, 97) disp_results(i:min(i+74,dl))
97 format (' ', A)
98 continue
return
end
C
C Subroutine: Print_Error
C Purpose: SQLCA error detected. Retrieve the error message
C and print it.
C Parameters:
C None
C
subroutine Print_Error
exec sql include sqlca
exec sql begin declare section
character*200 error_buf
exec sql end declare section
exec sql inquire_sql (:error_buf = ERRORTEXT)
print *, 'SQL Error:'
print *, error_buf
return
end
C
C Function:Read_Stmt
C Purpose: Reads a statement from standard input. This routine
C prompts the user for input (using a statement
C number) and scans input tokens for the statement
C delimiter (semicolon). The scan continues
C over new lines, and uses SQL string literal
C rules.
C Parameters:
C stmt_num - Statement number for prompt.
C stmt_buf - Buffer to fill for input.
C Returns:
C TRUE if a statement was read, FALSE if
C end-of-file typed.
C
integer function Read_Stmt(stmt_num, stmt_buf)
integer stmt_num
character*(*) stmt_buf
integer stmt_max
integer sl
character input_buf(256)
integer line_len
integer i
logical in_string
logical current_line
stmt_max = len(stmt_buf)
C Prompt user for SQL statement.
110 write (*, 111) stmt_num
111 format (' ', I3, ' ', $)
stmt_buf = ' '
in_string = .false.
sl = 1
C Loop while scanning input for statement terminator.
do while (.TRUE.)
C Read input line up to the number of characters entered
read (*, 112, err = 119, end = 119) line_len,
1 (input_buf(i), i = 1, line_len)
112 format (Q, 100A1)
current_line = .true. ! We are in a line
C
C Keep processing while we can (we have not reached the end of
C the line, and our statement buffer is not full).
C
i = 1
do while (current_line .and. (sl .le. stmt_max))
C Not in string - check for delimiters and new lines
if (.not. in_string) then
if (i .gt. line_len) then
C New line outside of string is replaced with blank
input_buf(i) = ' '
current_line = .false.
else if (input_buf(i) .eq. ';') then
Read_Stmt = .true.
return
else if (input_buf(i) .eq. '''') then
in_string = .true.
end if
stmt_buf(sl:sl) = input_buf(i)
sl = sl + 1
i = i + 1
else
C End of line inside string is ignored
if (i .gt. line_len) then
current_line = .false.
else if (input_buf(i) .eq. '''') then
in_string = .false.
end if
if (current_line) then
stmt_buf(sl:sl) = input_buf(i)
sl = sl + 1
i = i + 1
end if
end if
end do
C
C Dropped out of above loop because end of line reached or buffer
C limit exceeded.
C
C Statement is too large - ignore it and try again.
if (sl .gt. stmt_max) then
write (*, 113) stmt_max
113 format (' SQL Error: Maximum statement length
1 (', I4,') exceeded.')
goto 110
else
write (*, 114)
114 format (' ---> ', $)
end if
end do
119 Read_Stmt = .false.
return
end
C
C Procedure: UsrDataHandler
C Purpose: Use GET DATA to get the BLOB from the database.
C Parameters:
C hdlarg - the structure with handler info
subroutine UsrDataHandler (hdlarg)
exec sql include sqlca
exec sql whenever sqlerror stop
exec sql begin declare section
structure /hdlr_arg/
character*50 argstr
integer arglen
end structure
record /hdlr_arg/ hdlarg
character*50 segbuf
integer*4 dataend
integer*4 seglen
exec sql end declare sections
integer totlen
integer nsegs
if (hdlarg.arglen .gt. len(hdlarg.argstr)) then
hdlarg.arglen = len(hdlarg.argstr)
write (*,120) hdlarg.arglen
120 format ('BLOB length error....reducing to: ',I)
end if
nsegs = 0
totlen = 0
dataend = 0
do while ((dataend .eq. 0) .and. (totlen .lt. hdlarg.arglen))
segbuf= ' '
exec sql get data (:segbuf = segment,
1 :seglen = segmentlength,
2 :dataend = dataend)
3 with maxlength = :hdlarg.arglen;
hdlarg.argstr(totlen+1:) = segbuf(1:seglen)
nsegs = nsegs + 1
totlen = totlen + seglen
end do
if (dataend .eq. 0) then
exec sql enddata;
end if
end