-- Copyright © Oracle Corporation 1995. All Rights Reserved. -- SQL$ALL_DATATYPES.ADA -- -- ABSTRACT -- -- This program shows how to declare Ada host language variables -- to match a variety of SQL data types and how to specify those -- variables in SQL statements to store and retrieve column or -- null values. The program uses the module language interface -- and: -- -- o Creates the ALL_DATATYPES database and table -- o Stores a row using references to main variables and -- indicator variables -- o Retrieves that row -- o Displays the row on the terminal -- o Updates some column values in the row -- o Displays the changed row on the terminal -- o Deletes the database -- -- The name of the file containing the SQL module language -- procedures is SQL$ALL_DATATYPES_ADA.SQLMOD. -- -- DIRECTIONS -- -- To build this example, issue the following commands: -- -- $ ACS CREATE LIBRARY [.ADALIB] -- $ ACS SET LIB [.ADALIB] -- $ ADA/NOLIS SYS$LIBRARY:SQL$STANDARD -- $ SQLMOD -- SQL$ALL_DATATYPES_ADA/PACK -- $ ADA SQL$ALL_DATATYPES -- $ ACS LINK SQL_ALL_DATATYPES SQL$ALL_DATATYPES_ADA /EXEC=SQL$ALL_DATATYPES -- $ RUN SQL$ALL_DATATYPES -- -- If you use the /EXEC= qualifier, you should not have to rename the file. with CONDITION_HANDLING; with STARLET; with SYSTEM; use SYSTEM; with TEXT_IO; use TEXT_IO; procedure SQL_ALL_DATATYPES is -- Declare variables used for handling errors on calls to SQL module -- procedures. SQL_RETURN_STATUS : integer; SQL_SUCCESS : constant integer := 0; STREAM_EOF : constant integer := 100; DEADLOCK : constant integer := -913; INTEGRITY_FAILURE : constant integer := -1001; LOCK_CONFLICT : constant integer := -1003; NO_DUPLICATES : constant integer := -803; NOT_VALID : constant integer := -1002; DEADLOCK_ERROR, STREAM_EOF_ERROR, INTEGRITY_FAILURE_ERROR, LOCK_CONFLICT_ERROR, NO_DUPLICATES_ERROR, NOT_VALID_ERROR, UNEXPECTED_ERROR : exception; -- Declare variables for handling errors on calls to VMS system -- service routines. VMS_RETURN_STATUS : condition_handling.cond_value_type; IVTIME_ERROR : exception; -- Declare type for defining VARCHAR structures for SQL. type SQL_VARCHAR_40 is record l : short_integer range 1..40; t : string(1..40); end record; -- String subtypes subtype STRING10 is string(1..10); subtype STRING16 is string(1..16); -- Variables for main program use P_CHAR_COL : string10; P_VARCHAR_COL : sql_varchar_40; P_TINYINT_COL : short_short_integer; P_SMALLINT_COL : short_integer; P_INTEGER_COL : integer; P_REAL_COL : F_float; P_DOUBLE_PREC_COL : G_float; P_DATE_COL : starlet.date_time_type; P_STRING_DATE_DSRI : string16 := (others => ' '); P_CHAR_IND,P_VARCHAR_IND,P_TINYINT_IND,P_SMALLINT_IND,P_INTEGER_IND, P_REAL_IND,P_DOUBLE_PREC_IND,P_DATE_IND : short_integer := 0; ASCII_TIME : constant string := "22-APR-1987 10:17:56.00"; -- Package instantiations of text_io for tinyint, smallint, integer, real, -- and double-precision data types subtype tinyint is short_short_integer; subtype smallint is short_integer; subtype int is integer; subtype real is f_float; subtype dblprec is g_float; package TINYINT_IO is new integer_io(tinyint); package SMALLINT_IO is new integer_io(smallint); package INT_IO is new integer_io(int); package REAL_IO is new float_io(real); package DBLPREC_IO is new float_io(dblprec); -- SQL module language procedure declarations -- including the INTERFACE pragmas procedure CREATE_DATABASE(SQLCODE : out integer); procedure DROP_DATABASE(SQLCODE : out integer); procedure STORE_ALL_DATATYPES(SQLCODE : out integer; P_CHAR_COL : in string10; P_CHAR_IND : in short_integer; P_VARCHAR_COL : in sql_varchar_40; P_VARCHAR_IND : in short_integer; P_TINYINT_COL : in short_short_integer; P_TINYINT_IND : in short_integer; P_SMALLINT_COL : in short_integer; P_SMALLINT_IND : in short_integer; P_INTEGER_COL : in integer; P_INTEGER_IND : in short_integer; P_REAL_COL : in F_float; P_REAL_IND : in short_integer; P_DOUBLE_PREC_COL : in G_float; P_DOUBLE_PREC_IND : in short_integer; P_DATE_COL : in starlet.date_time_type; P_DATE_IND : in short_integer); procedure OPEN_CURSOR(SQLCODE : out integer); procedure CLOSE_CURSOR(SQLCODE : out integer); procedure FETCH_ALL_DATATYPES(SQLCODE : out integer; P_CHAR_COL : out string10; P_CHAR_IND : out short_integer; P_VARCHAR_COL : out sql_varchar_40; P_VARCHAR_IND : out short_integer; P_TINYINT_COL : out short_short_integer; P_TINYINT_IND : out short_integer; P_SMALLINT_COL : out short_integer; P_SMALLINT_IND : out short_integer; P_INTEGER_COL : out integer; P_INTEGER_IND : out short_integer; P_REAL_COL : out F_float; P_REAL_IND : out short_integer; P_DOUBLE_PREC_COL : out G_float; P_DOUBLE_PREC_IND : out short_integer; P_DATE_COL : out starlet.date_time_type; P_DATE_IND : out short_integer); procedure FETCH_CONVERT_ALL_DATATYPES(SQLCODE : out integer; P_CHAR_COL : out string10; P_CHAR_IND : out short_integer; P_VARCHAR_COL : out sql_varchar_40; P_VARCHAR_IND : out short_integer; P_TINYINT_COL : out short_short_integer; P_TINYINT_IND : out short_integer; P_SMALLINT_COL : out short_integer; P_SMALLINT_IND : out short_integer; P_INTEGER_COL : out integer; P_INTEGER_IND : out short_integer; P_REAL_COL : out F_float; P_REAL_IND : out short_integer; P_DOUBLE_PREC_COL : out G_float; P_DOUBLE_PREC_IND : out short_integer; P_STRING_DATE_DSRI : out string16; P_DATE_IND : out short_integer); procedure UPDATE_ALL_DATATYPES(SQLCODE : out integer; P_CHAR_COL : in string10; P_CHAR_IND : in short_integer; P_TINYINT_COL : in short_short_integer; P_TINYINT_IND : in short_integer; P_SMALLINT_COL : in short_integer; P_SMALLINT_IND : in short_integer; P_INTEGER_COL : in integer; P_INTEGER_IND : in short_integer); procedure ROLLBACK_TRANSACTION(SQLCODE: out integer); pragma INTERFACE(SQL, CREATE_DATABASE); pragma INTERFACE(SQL, DROP_DATABASE); pragma INTERFACE(SQL, STORE_ALL_DATATYPES); pragma INTERFACE(SQL, OPEN_CURSOR); pragma INTERFACE(SQL, CLOSE_CURSOR); pragma INTERFACE(SQL, FETCH_ALL_DATATYPES); pragma INTERFACE(SQL, FETCH_CONVERT_ALL_DATATYPES); pragma INTERFACE(SQL, UPDATE_ALL_DATATYPES); pragma INTERFACE(SQL, ROLLBACK_TRANSACTION); -------------------------------------------------------------------- -- Procedures used by the main program -------------------------------------------------------------------- procedure DISPLAY_VALUES is -- Variables for use in converting the date to a date/time string DATE_TIME_STRING : string(1..23) := (others => ' '); begin new_line(24); put_line("This is the stored row"); new_line; put("CHAR_COL: "); if p_char_ind < 0 then put_line("NULL"); else put_line(p_char_col); end if; put("VARCHAR_COL: "); if p_varchar_ind < 0 then put_line("NULL"); else put_line(p_varchar_col.t); end if; put("TINYINT_COL: "); if p_tinyint_ind < 0 then put_line("NULL"); else tinyint_io.put(p_tinyint_col); new_line; end if; put("SMALLINT_COL: "); if p_smallint_ind < 0 then put_line("NULL"); else smallint_io.put(p_smallint_col); new_line; end if; put("INTEGER_COL: "); if p_integer_ind < 0 then put_line("NULL"); else int_io.put(p_integer_col); new_line; end if; put("REAL_COL: "); if p_real_ind < 0 then put_line("NULL"); else real_io.put(p_real_col); new_line; end if; put("DOUBLE_PRECISION_COL: "); if p_double_prec_ind < 0 then put_line("NULL"); else dblprec_io.put(p_double_prec_col); new_line; end if; put("DATE_COL: "); if p_date_ind < 0 then put_line("NULL"); else -- Convert the DATE data type format for display using -- the ASCTIM system service routine in STARLET. Check -- the return status for errors. starlet.asctim(status => vms_return_status, timbuf => date_time_string, timadr => p_date_col); if not condition_handling.success(vms_return_status) then raise ivtime_error; end if; put_line(date_time_string); end if; end DISPLAY_VALUES; procedure DISPLAY_NEW_VALUES is begin new_line(24); put_line("This is the row after update"); new_line; put("CHAR_COL: "); if p_char_ind < 0 then put_line("NULL"); else put_line(p_char_col); end if; put("VARCHAR_COL: "); if p_varchar_ind < 0 then put_line("NULL"); else put_line(p_varchar_col.t); end if; put("TINYINT_COL: "); if p_tinyint_ind < 0 then put_line("NULL"); else tinyint_io.put(p_tinyint_col); new_line; end if; put("SMALLINT_COL: "); if p_smallint_ind < 0 then put_line("NULL"); else smallint_io.put(p_smallint_col); new_line; end if; put("INTEGER_COL: "); if p_integer_ind < 0 then put_line("NULL"); else int_io.put(p_integer_col); new_line; end if; put("REAL_COL: "); if p_real_ind < 0 then put_line("NULL"); else real_io.put(p_real_col); new_line; end if; put("DOUBLE_PRECISION_COL: "); if p_double_prec_ind < 0 then put_line("NULL"); else dblprec_io.put(p_double_prec_col); new_line; end if; put("DATE_COL: "); if p_date_ind < 0 then put_line("NULL"); else put(p_string_date_dsri(5..6)); put("/"); put(p_string_date_dsri(7..8)); put("/"); put(p_string_date_dsri(3..4)); put(" "); put(p_string_date_dsri(9..10)); put(":"); put(p_string_date_dsri(11..12)); put(":"); put_line(p_string_date_dsri(13..14)); end if; end DISPLAY_NEW_VALUES; -------------------------------------------------------------------- -- Main program -------------------------------------------------------------------- begin -- Create the database and table for this example. create_database(sql_return_status); case sql_return_status is when sql_success => null; when deadlock => raise deadlock_error; when lock_conflict => raise lock_conflict_error; when others => raise unexpected_error; end case; -- Initialize host language variables, including a conversion of time -- to DATE data type format. Set the null indicator parameters and -- store the row in the table. p_char_col := "Begin end"; p_varchar_col.l := 39; p_varchar_col.t(1..integer(p_varchar_col.l)) := "This string is 39 characters in length."; p_tinyint_col := short_short_integer'first; p_smallint_col := short_integer'first; p_integer_col := integer'first; p_real_col := 0.1234567; p_double_prec_col := 0.123456789012345; -- Convert the ASCII string time format to DATE data type format. -- Check for invalid time format error. starlet.bintim(vms_return_status,ascii_time,p_date_col); if not condition_handling.success(vms_return_status) then raise ivtime_error; end if; if p_char_col = " " then p_char_ind := -1; end if; if p_varchar_col.l = 0 then p_varchar_ind := -1; end if; if p_tinyint_col = 0 then p_tinyint_ind := -1; end if; if p_smallint_col = 0 then p_smallint_ind := -1; end if; if p_integer_col = 0 then p_integer_ind := -1; end if; if p_real_col = 0.0 then p_real_ind := -1; end if; if p_double_prec_col = 0.0 then p_double_prec_ind := -1; end if; if p_date_col.L0 = 0 and p_date_col.L1 = 0 then p_date_ind := -1; end if; store_all_datatypes(sql_return_status, p_char_col,p_char_ind, p_varchar_col,p_varchar_ind, p_tinyint_col,p_tinyint_ind, p_smallint_col,p_smallint_ind, p_integer_col,p_integer_ind, p_real_col,p_real_ind, p_double_prec_col,p_double_prec_ind, p_date_col,p_date_ind); case sql_return_status is when sql_success => null; when deadlock => raise deadlock_error; when integrity_failure => raise integrity_failure_error; when lock_conflict => raise lock_conflict_error; when no_duplicates => raise no_duplicates_error; when not_valid => raise not_valid_error; when others => raise unexpected_error; end case; -- Open the cursor, fetch a row, and display the row on the terminal. open_cursor(sql_return_status); case sql_return_status is when sql_success => null; when deadlock => raise deadlock_error; when lock_conflict => raise lock_conflict_error; when others => raise unexpected_error; end case; fetch_all_datatypes(sql_return_status, p_char_col,p_char_ind, p_varchar_col,p_varchar_ind, p_tinyint_col,p_tinyint_ind, p_smallint_col,p_smallint_ind, p_integer_col,p_integer_ind, p_real_col,p_real_ind, p_double_prec_col,p_double_prec_ind, p_date_col,p_date_ind); case sql_return_status is when sql_success => null; when stream_eof => raise stream_eof_error; when others => raise unexpected_error; end case; display_values; -- Modify some of the column values and update the table. p_char_ind := -1; p_tinyint_col := short_short_integer'last; p_smallint_col := short_integer'last; p_integer_col := integer'last; update_all_datatypes(sql_return_status, p_char_col,p_char_ind, p_tinyint_col,p_tinyint_ind, p_smallint_col,p_smallint_ind, p_integer_col,p_integer_ind); case sql_return_status is when sql_success => null; when deadlock => raise deadlock_error; when integrity_failure => raise integrity_failure_error; when lock_conflict => raise lock_conflict_error; when no_duplicates => raise no_duplicates_error; when not_valid => raise not_valid_error; when others => raise unexpected_error; end case; -- Close and open the cursor again to fetch and display the changed row. close_cursor(sql_return_status); case sql_return_status is when sql_success => null; when others => raise unexpected_error; end case; open_cursor(sql_return_status); case sql_return_status is when sql_success => null; when deadlock => raise deadlock_error; when lock_conflict => raise lock_conflict_error; when others => raise unexpected_error; end case; fetch_convert_all_datatypes(sql_return_status, p_char_col,p_char_ind, p_varchar_col,p_varchar_ind, p_tinyint_col,p_tinyint_ind, p_smallint_col,p_smallint_ind, p_integer_col,p_integer_ind, p_real_col,p_real_ind, p_double_prec_col,p_double_prec_ind, p_string_date_dsri,p_date_ind); case sql_return_status is when sql_success => null; when stream_eof => raise stream_eof_error; when others => raise unexpected_error; end case; display_new_values; -- Roll back the transaction and delete the database. rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; exception when ivtime_error => put_line("Invalid date format. Deleting database."); rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; when deadlock_error => put_line("Deadlock encountered. Deleting database."); rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; when lock_conflict_error => put_line("Locking conflict. Deleting database."); rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; when unexpected_error => put_line("Unexpected error. Deleting database."); rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; when stream_eof_error => put_line("No rows in table. Deleting database."); rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; when integrity_failure_error => put_line("Integrity failure. Deleting database."); when no_duplicates_error => put_line("Duplicate record found. Deleting database."); rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; when not_valid_error => put_line("Invalid data found. Deleting database."); rollback_transaction(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; drop_database(sql_return_status); case sql_return_status is when sql_success => null; when others => put("Database could not be deleted. "); put_line("Delete database files manually"); end case; end SQL_ALL_DATATYPES;