4. Embedded SQL for Fortran : Sample Applications : The SQL Terminal Monitor Application
 
Share this page                  
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".

           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).

           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