-- ABSTRACT: -- -- This module is the second in a series of two that demonstrate the -- dynamic interface of SQL using SQL module language and Ada. The -- first Ada module is sql_dynamic_driver.ada. -- -- This module processes the statement passed from the driver module. -- It calls PREPARE and DESCRIBE statements to write information about any -- parameter markers or select list items to separate SQLDA structures. -- If there are parameter markers, it allocates storage and prompts the -- user to supply values. If there are select list items, it allocates -- storage for them and sets up a fetch loop to display values. -- -- If the statement has syntax errors, the module returns the -- SQL SYNTAX_ERR message. -- with CONDITION_HANDLING; with STARLET; with SYSTEM; use SYSTEM; with TEXT_IO; use TEXT_IO; separate(SQL_DYNAMIC_DRIVER) procedure SQL_DYNAMIC(sql_stmt : in st) is -------------------------------------------------------------------------------- -- Declarations -------------------------------------------------------------------------------- -- The following declarations are for SQL error handling: SQL_SUCCESS : constant integer := 0; STREAM_EOF : constant integer := 100; DEADLOCK : constant integer := -913; LOCK_CONFLICT : constant integer := -1003; DEADLOCK_ERROR, LOCK_CONFLICT_ERROR, SYNTAX_ERROR, UNEXPECTED_ERROR : exception; SQL_ERROR_TEXT_LENGTH : short_integer; SQL_ERROR_TEXT : st; procedure SQL_GET_ERROR_TEXT(TEXT : out string; LENGTH : out short_integer); pragma INTERFACE(SQL, SQL_GET_ERROR_TEXT); pragma IMPORT_PROCEDURE(SQL_GET_ERROR_TEXT,"SQL$GET_ERROR_TEXT", (string,short_integer)); -- Instantiation of generics of TEXT_IO: subtype SMLINT is short_integer; package SMLINT_IO is new INTEGER_IO(smlint); subtype INT is integer; package INT_IO is new INTEGER_IO(int); subtype FLT is f_float; package FLT_IO is new FLOAT_IO(flt); -- Variables for main program use. -- -- This first group is for program control. -- VMS_RETURN_STATUS : condition_handling.cond_value_type; -- -- MAXPARMS is an arbitrary value that controls the size of -- the SQLDA at run time and limits the number of parameter -- markers or select list items that the program handles: -- MAXPARMS : constant short_integer := 20; -- -- MAXROWS is an arbitrary value that limits the number of table rows -- displayed by the fetch loop when the program processes a SELECT statement: -- MAXROWS : constant short_integer := 5; ROWCOUNT : short_integer range 0..maxrows := 0; stmt_id : integer; is_select :integer; -- -- This group declares access types (pointer variables) for each -- data type. The GET_IN_PARMS and ALLOCATE_BUFFERS procedures use the -- access types to dynamically allocate memory to hold values for parameter -- markers and select list items, respectively. -- type CHABUF_ACCESS is access string; CHABUF : chabuf_access; type CHVBUF_TYPE; type CHVBUF_TYPE_ACCESS is access CHVBUF_TYPE; type CHVBUF_TYPE is record chv_lng : short_integer; chv_str : st; end record; CHVBUF : chvbuf_type_access; type INTBUF_ACCESS is access integer; INTBUF : intbuf_access; type SMLINTBUF_ACCESS is access short_integer; SMLINTBUF : smlintbuf_access; type FLTBUF_ACCESS is access f_float; FLTBUF : fltbuf_access; type DATBUF_ACCESS is access starlet.date_time_type; DATBUF : datbuf_access; type INDBUF_ACCESS is access short_integer; INDBUF : indbuf_access; -- Declare two SQLDA structures, SQLDA_IN and SQLDA_OUT. type SQLNAME_REC is record NAME_LEN : short_integer; NAME_STR : string (1..30); end record; type SQLVAR_REC is record SQLTYPE : short_integer; SQLLEN : short_integer; SQLDATA : address; SQLIND : address; SQLNAME : sqlname_rec; end record; type SQLVAR_ARRAY is array (1..maxparms) of sqlvar_rec; type SQLDA_REC; type SQLDA_ACCESS is access SQLDA_REC; type SQLDA_REC is record SQLDAID : string (1..8) := "SQLDA "; SQLABC : integer; SQLN : short_integer; SQLD : short_integer; SQLVAR : sqlvar_array; end record; SQLDA_IN, SQLDA_OUT : sqlda_access; -- SQLCA declaration. type SQLERRM_REC is record SQLERRML : short_integer; SQLERRMC : string (1..70); end record; type SQLERRD_ARRAY is array (1..6) of integer; type SQLCA_REC; type SQLCA_ACCESS is access SQLCA_REC; type SQLCA_REC is record SQLCAID : string (1..8) := "SQLCA "; SQLABC : integer := 128; SQLCODE : integer; SQLERRM : sqlerrm_rec; SQLERRD : sqlerrd_array; SQLWARN0 : character := ' '; SQLWARN1 : character := ' '; SQLWARN2 : character := ' '; SQLWARN3 : character := ' '; SQLWARN4 : character := ' '; SQLWARN5 : character := ' '; SQLWARN6 : character := ' '; SQLWARN7 : character := ' '; SQLEXT : string (1..8) := " "; end record; SQLCA_STATUS : SQLCA_ACCESS; -- Declare all the SQL module language procedures in sql_dynamic_ada.sqlmod. -- The INTERFACE pragma is a compiler directive that indicates the -- procedures are not Ada procedures. -- procedure PREPARE_STMT(SQLCA : out sqlca_rec; STMT : in st); pragma INTERFACE(SQL, PREPARE_STMT); procedure DESCRIBE_SELECT(SQLCA : out sqlca_rec; SQLDA : in out sqlda_rec); pragma INTERFACE(SQL, DESCRIBE_SELECT); procedure DESCRIBE_PARM(SQLCA : out sqlca_rec; SQLDA : in out sqlda_rec); pragma INTERFACE(SQL, DESCRIBE_PARM); procedure EXECUTE_STMT(SQLCA : out sqlca_rec; SQLDA : in out sqlda_rec); pragma INTERFACE(SQL, EXECUTE_STMT); procedure OPEN_CURSOR(SQLCA : out sqlca_rec; SQLDA : in out sqlda_rec); pragma INTERFACE(SQL, OPEN_CURSOR); procedure FETCH_ROW(SQLCA : out sqlca_rec; SQLDA : in out sqlda_rec); pragma INTERFACE(SQL, FETCH_ROW); procedure CLOSE_CURSOR(SQLCA : out sqlca_rec); pragma INTERFACE(SQL, CLOSE_CURSOR); procedure RELEASE_STMT(SQLCA : out sqlca_rec); pragma INTERFACE(SQL, RELEASE_STMT); procedure COMMIT_TRANSACTION(SQLCA : out sqlca_rec); pragma INTERFACE(SQL, COMMIT_TRANSACTION); procedure ROLLBACK_TRANSACTION(SQLCA : out sqlca_rec); pragma INTERFACE(SQL, ROLLBACK_TRANSACTION); -------------------------------------------------------------------------- -- Procedures used by the main program -------------------------------------------------------------------------- -------------------------------------------------------------------------- -- GET_IN_PARMS allocates storage for parameter markers in the statement -- string supplied by the user. It also prompts the user for values to place -- in that storage, assigns the values to the storage, and places -- addresses of the storage in SQLDA_IN. -------------------------------------------------------------------------- procedure GET_IN_PARMS is PARM : short_integer := 0; LOOP_CNTR : integer; begin -- For each parameter marker indicated by sqlda_in.sqld, execute a loop: -- for parm in 1..sqlda_in.sqld loop -- Check the value of sqlda_in.sqlvar.sqltype to determine the data -- type of the parameter marker, and branch to the prompting and -- storage routine for that data type. -- case sqlda_in.sqlvar(parm).sqltype is when 453 => -- character variable loop -- Prompt with column name from sqlda.sqlvar.sqlname. -- put("Enter value for "); put_line( sqlda_in.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_in.sqlvar(parm).sqlname.name_len))); -- Prompt with maximum length from sqlda.sqlvar.sqlname. -- put("Maximum length is "); smlint_io.put(sqlda_in.sqlvar(parm).sqllen,width => 4); put(" characters> "); -- Allocate storage for previously declared buffer. -- chabuf := new string(1..integer(sqlda_in.sqlvar(parm).sqllen)); -- Assign the value entered by the user to the buffer. -- get_line(chabuf.all,last); new_line; if last > 0 then for cntr in (last + 1)..integer(sqlda_in.sqlvar(parm).sqllen) loop chabuf.all(cntr) := ' '; end loop; -- Write the address of the buffer to sqlda_in.sqlvar.sqldata. -- sqlda_in.sqlvar(parm).sqldata := chabuf.all'address; exit; else -- Prompt the user again if nothing is entered. -- put_line("Value required. Please re-enter."); new_line; end if; end loop; when 449 => -- varchar variable loop put("Enter value for "); put_line( sqlda_in.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_in.sqlvar(parm).sqlname.name_len))); put("Maximum length is "); smlint_io.put(sqlda_in.sqlvar(parm).sqllen,width => 4); put(" characters> "); chvbuf := new chvbuf_type; chvbuf.chv_lng := sqlda_in.sqlvar(parm).sqllen; get_line(chvbuf.chv_str,last); new_line; if last > 0 then sqlda_in.sqlvar(parm).sqllen := short_integer(last); sqlda_in.sqlvar(parm).sqldata := chvbuf.all'address; exit; else put_line("Value required. Please re-enter."); new_line; end if; end loop; when 497 => -- integer variable loop put("Enter value for "); put_line( sqlda_in.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_in.sqlvar(parm).sqlname.name_len))); put(" Integer value> "); intbuf := new integer; int_io.get(intbuf.all); new_line; if intbuf.all /= 0 then sqlda_in.sqlvar(parm).sqldata := intbuf.all'address; exit; else put_line("Value required. Please re-enter."); new_line; end if; end loop; when 501 => -- smallint variable loop put("Enter value for "); put_line( sqlda_in.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_in.sqlvar(parm).sqlname.name_len))); put(" Smallint value> "); smlintbuf := new short_integer; smlint_io.get(smlintbuf.all); new_line; if smlintbuf.all /= 0 then sqlda_in.sqlvar(parm).sqldata := smlintbuf.all'address; else put_line("Value required. Please re-enter."); new_line; end if; end loop; when 481 => -- float variable loop put("Enter value for "); put_line( sqlda_in.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_in.sqlvar(parm).sqlname.name_len))); put(" Floating-point value> "); fltbuf := new f_float; flt_io.get(fltbuf.all); new_line; if fltbuf.all /= 0.0 then sqlda_in.sqlvar(parm).sqldata := fltbuf.all'address; else put_line("Value required. Please re-enter."); new_line; end if; end loop; when 503 => -- date variable put("Enter value for "); put_line( sqlda_in.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_in.sqlvar(parm).sqlname.name_len))); put(" Date value in dd-MMM-yyyy:hh:mm:ss.hh format> "); chabuf := new string(1..23); get_line(chabuf.all,last); new_line; datbuf := new starlet.date_time_type; starlet.bintim(vms_return_status,chabuf.all,datbuf.all); sqlda_in.sqlvar(parm).sqldata := datbuf.all'address; when others => raise unexpected_error; end case; end loop; exception when data_error => put_line("Entry must be numeric."); when unexpected_error => put("An unexpected error occurred. The value "); smlint_io.put(sqlda_out.sqlvar(parm).sqltype, width => 4); put_line(" was returned for SQL type."); end GET_IN_PARMS; -------------------------------------------------------------------------- -- ALLOCATE_BUFFERS allocates storage for select list items in the -- statement string supplied by the user. It also allocates storage for -- indicator parameters associated with the select list items. -------------------------------------------------------------------------- procedure ALLOCATE_BUFFERS is PARM : short_integer := 0; begin -- For each parameter marker indicated by sqlda_out.sqld, execute a loop: -- for parm in 1..sqlda_out.sqld loop -- Allocate storage for an indicator array, indbuf. -- indbuf := new short_integer'(0); -- Write the address of INDBUF to SQLDA_OUT.SQLVAR.SQLIND sqlda_out.sqlvar(parm).sqlind := indbuf.all'address; -- Check the value of sqlda_out.sqlvar.sqltype to determine the data -- type of the select list item and branch to allocation routine -- for that data type. -- case sqlda_out.sqlvar(parm).sqltype is when 453 => -- character variable -- Allocate storage for previously declared buffer. chabuf := new string(1..integer(sqlda_out.sqlvar(parm).sqllen)); -- Write the address of the buffer to SQLDA_VAR.SQLVAR.SQLDATA sqlda_out.sqlvar(parm).sqldata := chabuf.all'address; when 449 => -- varchar variable chvbuf := new chvbuf_type; chvbuf.chv_lng := sqlda_out.sqlvar(parm).sqllen; sqlda_out.sqlvar(parm).sqldata := chvbuf.all'address; when 497 => -- integer variable intbuf := new integer; sqlda_out.sqlvar(parm).sqldata := intbuf.all'address; when 501 => -- smallint variable smlintbuf := new short_integer; sqlda_out.sqlvar(parm).sqldata := smlintbuf.all'address; when 481 => -- float variable fltbuf := new f_float; sqlda_out.sqlvar(parm).sqldata := fltbuf.all'address; when 503 => -- date variable datbuf := new starlet.date_time_type; sqlda_out.sqlvar(parm).sqldata := datbuf.all'address; when others => raise unexpected_error; end case; end loop; exception when unexpected_error => put("An unexpected error occurred. The value "); smlint_io.put(sqlda_out.sqlvar(parm).sqltype, width => 4); put_line(" was returned for SQL type."); end ALLOCATE_BUFFERS; -------------------------------------------------------------------------- -- DISPLAY_ROW reads the addresses from sqlda_out for storage -- allocated in the ALLOCATE_BUFFERS procedure. It displays the name -- and value of each column on the terminal. -------------------------------------------------------------------------- procedure DISPLAY_ROW is PARM : short_integer := 0; ST_BUF : st; function FETCH_CHA is new FETCH_FROM_ADDRESS(st); function FETCH_CHV is new FETCH_FROM_ADDRESS(chvbuf_type); function FETCH_INT is new FETCH_FROM_ADDRESS(integer); function FETCH_SMLINT is new FETCH_FROM_ADDRESS(short_integer); function FETCH_FLT is new FETCH_FROM_ADDRESS(f_float); function FETCH_DAT is new FETCH_FROM_ADDRESS(starlet.date_time_type); begin -- For each select list item indicated in SQLDA_OUT.SQLD, execute a loop: -- for parm in 1..sqlda_out.sqld loop -- Check the value of SQLDA_OUT.SQLVAR.SQLTYPE to determine the data -- type of the select list item and branch to display the routine -- for that data type. -- case sqlda_out.sqlvar(parm).sqltype is when 453 => -- character variable -- Display the column name from sqlda_out.sqlvar.sqlname. -- put( sqlda_out.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_out.sqlvar(parm).sqlname.name_len))); put(": "); -- Check to see if the indicator array shows a null value. -- if fetch_smlint(sqlda_out.sqlvar(parm).sqlind) < 0 then put("NULL"); else -- Get the address of the buffer that contains -- the column value (written by a FETCH statement) -- from sqlda_out.sqlvar.sqldata. -- st_buf := fetch_cha(sqlda_out.sqlvar(parm).sqldata); -- Display the value in the buffer. -- put(st_buf(1..integer(sqlda_out.sqlvar(parm).sqllen))); end if; new_line; when 449 => -- varchar variable put( sqlda_out.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_out.sqlvar(parm).sqlname.name_len))); put(": "); if fetch_smlint(sqlda_out.sqlvar(parm).sqlind) < 0 then put("NULL"); else chvbuf := new chvbuf_type; chvbuf.all := fetch_chv(sqlda_out.sqlvar(parm).sqldata); put(chvbuf.chv_str(1..integer(chvbuf.chv_lng))); end if; new_line; when 497 => -- integer variable put( sqlda_out.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_out.sqlvar(parm).sqlname.name_len))); put(": "); if fetch_smlint(sqlda_out.sqlvar(parm).sqlind) < 0 then put("NULL"); else int_io.put(fetch_int(sqlda_out.sqlvar(parm).sqldata)); end if; new_line; when 501 => -- smallint variable put( sqlda_out.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_out.sqlvar(parm).sqlname.name_len))); put(": "); if fetch_smlint(sqlda_out.sqlvar(parm).sqlind) < 0 then put("NULL"); else smlint_io.put(fetch_smlint(sqlda_out.sqlvar(parm).sqldata)); end if; new_line; when 481 => -- float variable put( sqlda_out.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_out.sqlvar(parm).sqlname.name_len))); put(": "); if fetch_smlint(sqlda_out.sqlvar(parm).sqlind) < 0 then put("NULL"); else flt_io.put(fetch_flt(sqlda_out.sqlvar(parm).sqldata)); end if; new_line; when 503 => -- date variable put( sqlda_out.sqlvar(parm).sqlname.name_str( 1..integer(sqlda_out.sqlvar(parm).sqlname.name_len))); put(": "); if fetch_smlint(sqlda_out.sqlvar(parm).sqlind) < 0 then put("NULL"); else chabuf := new string(1..23); datbuf := new starlet.date_time_type; datbuf.all := fetch_dat(sqlda_out.sqlvar(parm).sqldata); starlet.asctim(status => vms_return_status, timbuf => chabuf.all, timadr => datbuf.all); put(chabuf.all); end if; new_line; when others => raise unexpected_error; end case; end loop; new_line; exception when unexpected_error => put("An unexpected error occurred. The value "); smlint_io.put(sqlda_out.sqlvar(parm).sqltype, width => 4); put_line(" was returned for SQL type."); end DISPLAY_ROW; -------------------------------------------------------------------------------- -- Main program for SQL_DYNAMIC subunit -------------------------------------------------------------------------------- begin -- Allocate separate SQLDAs for parameter markers (sqlda_in) and select list -- items (sqlda_out). Assign the value of the constant MAXPARMS (set in the -- declarations section of this module) to the SQLN field of both SQLDA -- structures. SQLN specifies to SQL the maximum size of the SQLDA. -- sqlda_in := new sqlda_rec; sqlda_in.sqln := maxparms; sqlda_out := new sqlda_rec; sqlda_out.sqln := maxparms; sqlca_status := new sqlca_rec; -- Call the SQL module language procedures prepare_stmt which contains a -- PREPARE statement to prepare the dynamic statement, and describe_select, -- which contains a DESCRIBE...SELECT_LIST statement to write information about any -- select list items in it to SQLDA_OUT. -- prepare_stmt(sqlca_status.all, sql_stmt); case SQLCA_STATUS.SQLCODE is when sql_success => null; when others => raise syntax_error; end case; describe_select(sqlca_status.all, sqlda_out.all); case SQLCA_STATUS.SQLCODE is when sql_success => null; when others => raise syntax_error; end case; -- Save the value of the SQLCA.SQLERRD(2) field so that program can -- determine if the statement is a SELECT statement or not. -- If the value is 1, the statement is a SELECT statement. is_select := SQLCA_STATUS.SQLERRD(2); -- Call an SQL module language procedure, describe_parm, that contains a -- DESCRIBE...MARKERS statement to write information about any parameter -- markers in the dynamic statement to sqlda_in: -- describe_parm(sqlca_status.all,sqlda_in.all); case SQLCA_STATUS.SQLCODE is when sql_success => null; when others => raise unexpected_error; end case; -- Check to see if the prepared dynamic statement contains any parameter -- markers by looking at the SQLD field of sqlda_in. SQLD contains the -- number of parameter markers in the prepared statement. If SQLD is -- positive, the prepared statement contains parameter markers. The program -- executes a local procedure, get_in_parms, that prompts the user for -- values, allocates storage for those values, and updates the SQLDATA field -- of sqlda_in: -- if sqlda_in.sqld > 0 then get_in_parms; end if; -- Check to see if the prepared dynamic statement contains any select list -- items by looking at SQLCA.SQLERRD(2) field. If the value of the field -- is equal to 1, the prepared statement is a SELECT statement. The program -- allocates storage for the rows, calls SQL module language procedures to open -- and fetch from a cursor, and displays the rows on the terminal: if is_select = 1 then allocate_buffers; -- Open the cursor. -- open_cursor(sqlca_status.all,sqlda_in.all); case SQLCA_STATUS.SQLCODE is when sql_success => null; when others => raise unexpected_error; end case; -- Fetch the first row from the result table. -- fetch_row(sqlca_status.all,sqlda_out.all); case SQLCA_STATUS.SQLCODE is -- Check to see if the result table has any rows. -- when sql_success => null; when stream_eof => put_line("No records found."); new_line; when others => raise unexpected_error; end case; -- Set up a loop to display first row, -- fetch and display second and subsequent rows. -- rowcount := 0; while SQLCA_STATUS.SQLCODE = 0 loop rowcount := rowcount + 1; -- Execute DISPLAY_ROW procedure. -- display_row; -- To only display five rows, exit the loop if loop counter -- equals MAXROW (coded as 5 in this program). -- if rowcount = maxrows then exit; end if; -- Fetch another row, exit the loop if no more. fetch_row(sqlca_status.all,sqlda_out.all); case SQLCA_STATUS.SQLCODE is when sql_success => null; when stream_eof => exit; when others => raise unexpected_error; end case; end loop; -- Close the cursor. -- close_cursor(sqlca_status.all); case SQLCA_STATUS.SQLCODE is when sql_success => null; when others => raise unexpected_error; end case; else -- If the SQLCA.SQLERRD(2) field is not 1, then the prepared statement is not -- a SELECT statement and it only needs to be executed. Call an SQL module -- language procedure to execute the statement, using the information about -- parameter markers stored in sqlda_in by the local procedure get_in_parms: -- execute_stmt(sqlca_status.all,sqlda_in.all); case SQLCA_STATUS.SQLCODE is when sql_success => null; when others => raise unexpected_error; end case; end if; -- Once the program executes the statement, call an SQL module language -- procedure that contains a RELEASE statement to release resources used by -- the prepared statement. -- -- The RELEASE statement is not strictly necessary. If the statement is -- not released explicitly, it will be released the next time the -- program prepares the same statement name. However, if you know you -- will not want to use the statement again, it is good practice to -- release the statement. release_stmt(sqlca_status.all); case SQLCA_STATUS.SQLCODE is when sql_success => null; when others => raise unexpected_error; end case; exception when syntax_error => sql_get_error_text(sql_error_text,sql_error_text_length); put(sql_error_text(1..integer(sql_error_text_length))); new_line; when unexpected_error => sql_get_error_text(sql_error_text,sql_error_text_length); put(sql_error_text(1..integer(sql_error_text_length))); new_line; end SQL_DYNAMIC;