Release 8.0
A58231-01
 Library |
 Product |
 Contents |
 Index |
| SQL*Module for Ada Programmer's Guide Release 8.0 A58231-01 |
|
This chapter provides information about using SQL*Module host applications written in Ada. This chapter also includes sample programs that demonstrate how you can use SQL*Module with an Ada application.
Topics covered are:
You must use the datatypes defined in the supplied SQL_STANDARD package.The SQL_STANDARD package defines the packages, Ada bindings to the SQL datatypes, and the subtypes that are used for SQL*Module with Ada. You must compile the supplied SQL_STANDARD package into your Ada library, and with this package in each program unit that calls procedures generated from Module Language source, or that calls interface procedures.
The SQL_STANDARD package is system specific. See your system-specific Oracle documentation for the location of this file on your system.
The standard type of the SQLCODE parameter for Ada is SQL_STANDARD.SQLCODE_TYPE.
The standard type of the SQLSTATE parameter for Ada is SQL_STANDARD.SQLSTATE_TYPE. It is a five-character string.
The Module Language sample programs are based on an example database for a small college. This section demonstrates the tables that are used in the application, and a module that contains cursors and procedures that query and update the tables.
The database contains tables that maintain records about
The SQL statements below are used to create the tables used in the demonstration application. You can create the sample database, and fill it with some preliminary data, by using SQL*Plus or SQL*DBA to execute these scripts.
These scripts, and all other sample code files, are shipped with SQL*Module. They are in the demo directory on your system.
The tables and sequence number generators are created by the MKTABLES.SQL script. At the end of this script, five other scripts are called to partially populate the tables. These five scripts are listed following MKTABLES.SQL.
REM Create all tables for the sample college database application. REM Drop existing tables REM Remove REMs next 6 lines when running under SQL*Plus REM CLEAR SCREEN REM Prompt WARNING!! About to recreate the SQL*Module example tables. REM Prompt All previously entered data will be lost. REM Prompt If you really want to do this, type ENTER or Return. REM Prompt Else, type your CANCEL (INTR) character to exit REM Pause this script now. REM Prompt Dropping tables... DROP TABLE students CASCADE CONSTRAINTS; DROP TABLE instructors CASCADE CONSTRAINTS; DROP TABLE courses CASCADE CONSTRAINTS; DROP TABLE classes CASCADE CONSTRAINTS; DROP TABLE enrollment CASCADE CONSTRAINTS; DROP TABLE departments CASCADE CONSTRAINTS; DROP SEQUENCE student_id_seq; DROP SEQUENCE instructor_id_seq; DROP SEQUENCE class_number_seq; DROP SEQUENCE enrollment_seq; CREATE SEQUENCE student_id_seq START WITH 1000; CREATE SEQUENCE instructor_id_seq START WITH 100000; CREATE SEQUENCE class_number_seq START WITH 100; CREATE SEQUENCE enrollment_seq START WITH 100; REM Prompt Creating tables... CREATE TABLE departments (name VARCHAR2(16) NOT NULL, id NUMBER(6) PRIMARY KEY, location NUMBER(4), chairperson NUMBER(6), budget NUMBER(9,2) ); CREATE TABLE instructors (last_name VARCHAR2(15) NOT NULL, first_name VARCHAR2(15) NOT NULL, mi VARCHAR2(3), id NUMBER(6) PRIMARY KEY, hire_date DATE, dept NUMBER(6) NOT NULL REFERENCES departments(id), salary NUMBER(9,2), rank VARCHAR2(20) ); CREATE TABLE students (last_name VARCHAR2(15) NOT NULL, first_name VARCHAR2(15) NOT NULL, mi VARCHAR2(3), id NUMBER(6) PRIMARY KEY, status VARCHAR2(5) NOT NULL, date_of_birth DATE, matric_date DATE, grad_date DATE, major NUMBER(6) REFERENCES departments(id), advisor_id NUMBER(6) REFERENCES instructors(id) ); CREATE TABLE courses (dept NUMBER(6) NOT NULL REFERENCES departments(id), id NUMBER(6), name VARCHAR2(38) NOT NULL ); CREATE TABLE classes (class_number NUMBER(6) PRIMARY KEY, course_number NUMBER(6) NOT NULL, dept NUMBER(6) NOT NULL, max_enrollment NUMBER(4) NOT NULL, building_number NUMBER(4), room_number NUMBER(5), instructor NUMBER(6), quarter NUMBER(1), year NUMBER(4) ); CREATE TABLE enrollment (e_sn NUMBER(6) PRIMARY KEY, class_no NUMBER(6) NOT NULL, student_id NUMBER(6) NOT NULL, grade NUMBER(3,2), comments VARCHAR2(255) ); REM Prompt INSERTing sample data in tables... @@departmt.sql @@instrucs.sql @@students.sql @@courses.sql @@enrolmnt.sql
DELETE FROM departments; INSERT INTO departments VALUES ('BIOLOGY', 100, 2510, null, 100000); INSERT INTO departments VALUES ('CHEMISTRY', 110, 2510, null, 50000); INSERT INTO departments VALUES ('COMPUTER SCIENCE', 120, 2530, null, 110000); INSERT INTO departments VALUES ('ELECTRIC. ENG.', 130, 2530, null, 145000); INSERT INTO departments VALUES ('FINE ARTS', 140, 2520, null, 10000); INSERT INTO departments VALUES ('HISTORY', 150, 2520, null, 20000); INSERT INTO departments VALUES ('MATHEMATICS', 160, 2580, null, 5000); INSERT INTO departments VALUES ('MECH. ENG.', 170, 2520, null, 100000); INSERT INTO departments VALUES ('PHYSICS', 180, 2560, null, 300000);
DELETE FROM instructors; REM Add some faculty to the college INSERT INTO instructors VALUES ('Webster', 'Milo', 'B', 9000, '01-SEP-49', 140, 40000, 'PROFESSOR'); INSERT INTO instructors VALUES ('Crown', 'Edgar', 'G', 9001, '03-SEP-70', 150, 35000, 'PROFESSOR'); INSERT INTO instructors VALUES ('Golighty', 'Claire', 'M', 9002, '24-AUG-82', 120, 33000, 'ASSISTANT PROFESSOR'); INSERT INTO instructors VALUES ('Winterby', 'Hugh', '', 9003, '10-SEP-82', 120, 43000, 'PROFESSOR'); INSERT INTO instructors VALUES ('Whipplethorpe', 'Francis', 'X', 9004, '01-SEP-78', 170, 50000, 'PROFESSOR'); INSERT INTO instructors VALUES ('Shillingsworth', 'Susan', 'G', 9005, '22-AUG-87', 160, 65000, 'PROFESSOR'); INSERT INTO instructors VALUES ('Herringbone', 'Leo', 'R', 9006, '02-JAN-81', 110, 40000, 'ASSOCIATE PROFESSOR'); INSERT INTO instructors VALUES ('Willowbough', 'George', 'T', 9007, '04-SEP-86', 180, 37000, 'ASSOCIATE PROFESSOR'); INSERT INTO instructors VALUES ('Higham', 'Earnest', 'V', 9008, '10-JUN-76', 100, 55000, 'PROFESSOR');
DELETE FROM students; INSERT INTO students VALUES ('Brahms', 'Susan', 'F', student_id_seq.nextval, 'FT', '10-JUN-75', sysdate, null, null, null); INSERT INTO students VALUES ('Hiroki', 'Minoru', '', student_id_seq.nextval, 'FT', '12-AUG-71', sysdate, null, null, null); INSERT INTO students VALUES ('Hillyard', 'James', 'T', student_id_seq.nextval, 'FT', '11-SEP-74', sysdate, null, null, null); INSERT INTO students VALUES ('Kaplan', 'David', 'J', student_id_seq.nextval, 'FT', '02-MAR-74', sysdate, null, null, null); INSERT INTO students VALUES ('Jones', 'Roland', 'M', student_id_seq.nextval, 'FT', '23-JAN-75', sysdate, null, null, null); INSERT INTO students VALUES ('Rubin', 'Naomi', 'R', student_id_seq.nextval, 'PT', '23-FEB-54', sysdate, null, null, null); INSERT INTO students VALUES ('Gryphon', 'Melissa', 'E', student_id_seq.nextval, 'FT', '08-JUL-75', sysdate, null, null, null); INSERT INTO students VALUES ('Chen', 'Michael', 'T', student_id_seq.nextval, 'FT', '22-OCT-72', sysdate, null, null, null);
DELETE FROM courses; REM Add a few courses for demo purposes -- HISTORY INSERT INTO courses VALUES (150, 101, 'INTRODUCTION TO VENUSIAN CIVILIZATION'); INSERT INTO courses VALUES (150, 236, 'EARLY MEDIEVAL HISTORIOGRAPHY'); INSERT INTO courses VALUES (150, 237, 'MIDDLE MEDIEVAL HISTORIOGRAPHY'); INSERT INTO courses VALUES (150, 238, 'LATE MEDIEVAL HISTORIOGRAPHY'); -- MATHEMATICS INSERT INTO courses VALUES (160, 101, 'ANALYSIS I'); INSERT INTO courses VALUES (160, 102, 'ANALYSIS II'); INSERT INTO courses VALUES (160, 523, 'ADVANCED NUMBER THEORY'); INSERT INTO courses VALUES (160, 352, 'TOPOLOGY I'); -- COMPUTER SCIENCE INSERT INTO courses VALUES (120, 210, 'COMPUTER NETWORKS I'); INSERT INTO courses VALUES (120, 182, 'OBJECT-ORIENTED DESIGN'); INSERT INTO courses VALUES (120, 141, 'INTRODUCTION TO Ada'); INSERT INTO courses VALUES (120, 140, 'ADVANCED 7090 ASSEMBLER');
REM Create some classes and enroll some students in REM them, to test the procedures that access REM the ENROLLMENT table. DELETE FROM classes; REM Department 150 is HISTORY INSERT INTO classes VALUES (900, 101, 150, 300, 2520, 100, 9001, 1, 1990); INSERT INTO classes VALUES (901, 236, 150, 20, 2520, 111, 9001, 3, 1990); INSERT INTO classes VALUES (902, 237, 150, 15, 2520, 111, 9001, 4, 1990); INSERT INTO classes VALUES (903, 238, 150, 10, 2520, 111, 9001, 1, 1991); REM Department 120 is COMPUTER SCIENCE INSERT INTO classes VALUES (910, 210, 120, 60, 2530, 34, 9003, 1, 1990); INSERT INTO classes VALUES (911, 182, 120, 120, 2530, 440, 9003, 1, 1991); INSERT INTO classes VALUES (912, 141, 120, 60, 2530, 334, 9003, 2, 1990); INSERT INTO classes VALUES (913, 140, 120, 300, 2530, 112, 9003, 1, 1989); REM Now enroll Susan and Michael in some courses. DELETE FROM enrollment WHERE student_id = (SELECT id FROM students WHERE first_name = 'Susan' AND last_name = 'Brahms'); DELETE FROM enrollment WHERE student_id = (SELECT id FROM students WHERE first_name = 'Michael' AND last_name = 'Chen'); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 900, 1000, 3.0, 'Good'); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 901, 1000, 3.5, 'Very Good'); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 902, 1000, 4.0, 'Excellent'); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 903, 1000, 2.0, 'Fair'); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 910, 1007, 3.0, ' '); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 911, 1007, 3.0, ' '); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 912, 1007, 4.0, ' '); INSERT INTO enrollment VALUES (enrollment_seq.nextval, 913, 1007, 2.0, ' ');
-- SQL*Module demonstration module. -- Contains procedures to maintain the college database. -- PREAMBLE MODULE demomod LANGUAGE Ada AUTHORIZATION modtest ------------------------------------------------------------------ ------------------------- STUDENTS TABLE------------------------- ------------------------------------------------------------------ -- The following cursors and procedures access the STUDENTS table -- or the STUDENT_ID_SEQ sequence number generator. -- Declare a cursor to select all students -- in the college. DECLARE GET_STUDENTS_CURS CURSOR FOR SELECT last_name, first_name, mi, id, status, major, advisor_id FROM students -- Define procedures to open and close this cursor. PROCEDURE open_get_students_curs ( SQLCODE); OPEN GET_STUDENTS_CURS; PROCEDURE close_get_students_curs ( SQLCODE); CLOSE GET_STUDENTS_CURS; -- Define a procedure to fetch using the -- get_students_curs cursor. PROCEDURE get_all_students ( :lname CHAR(15), :fname CHAR(15), :mi CHAR(3), :mi_ind SMALLINT, :id INTEGER, :status CHAR(5), :major INTEGER, :major_ind SMALLINT, -- indicator for major :adv INTEGER, :adv_ind SMALLINT, -- indicator for advisor SQLCODE); FETCH get_students_curs INTO :lname, :fname, :mi INDICATOR :mi_ind, :id, :status, :major INDICATOR :major_ind, :adv INDICATOR :adv_ind; -- Add a new student -- to the database. Some of the columns in the -- table are entered as null in this procedure. -- The UPDATE_STUDENT procedure is used to fill -- them in later. PROCEDURE add_student ( :last_name CHARACTER(15), :first_name CHARACTER(15), :mi CHARACTER(3), :mi_ind SMALLINT, :sid INTEGER, :status CHARACTER(5), :date_of_birth CHARACTER(9), :dob_ind SMALLINT, SQLCODE); INSERT INTO students VALUES ( :last_name, :first_name, :mi :mi_ind, :sid, :status, :date_of_birth :dob_ind, sysdate, -- use today's date -- for start date null, -- no graduation date yet null, -- no declared major yet null -- no advisor yet ); -- Update a student's record to add or change -- status, major subject, advisor, and graduation date. PROCEDURE update_student ( :sid INTEGER, -- student's id number :major INTEGER, -- dept number of major :major_ind SMALLINT, -- indicator for major :advisor INTEGER, -- advisor's ID number :advisor_ind SMALLINT, :grd_date CHARACTER(9), :grad_date_ind SMALLINT, SQLCODE); UPDATE students SET grad_date = :grd_date INDICATOR :grad_date_ind, major = :major INDICATOR :major_ind, advisor_id = :advisor INDICATOR :advisor_ind WHERE id = :sid; PROCEDURE delete_student ( :sid INTEGER, SQLCODE); DELETE FROM students WHERE id = :sid; -- Get an ID number for a new student -- using the student_id sequence generator. This -- is done so that the ID number can be returned -- to the add_student routine that calls -- ENROLL. PROCEDURE get_new_student_id ( :new_id INTEGER, SQLCODE); SELECT student_id_seq.nextval INTO :new_id FROM dual; -- Return the name -- of a student, given the ID number. PROCEDURE get_student_name_from_id ( :sid INTEGER, :lname CHAR(15), :fname CHAR(15), :mi CHAR(3), SQLCODE); SELECT last_name, first_name, mi INTO :lname, :fname, :mi FROM students WHERE id = :sid; ------------------------------------------------------------------ ------------------------- INSTRUCTORS TABLE --------------------- ------------------------------------------------------------------ -- Define a procedure to return an instructor's last -- name, given the ID number. PROCEDURE get_instructor_name_from_id ( :iid INTEGER, :lname CHAR(15), :fname CHAR(15), :imi CHAR(3), :mi_ind SMALLINT, SQLCODE); SELECT last_name, first_name, mi INTO :lname, :fname, :imi INDICATOR :mi_ind FROM instructors WHERE id = :iid; ------------------------------------------------------------------ ------------------------- DEPARTMENTS TABLE --------------------- ------------------------------------------------------------------ -- Define procedure to return the name of a department -- given its ID number. PROCEDURE get_department_name_from_id ( :did INTEGER, :dept_name CHARACTER(16), SQLCODE); SELECT name INTO :dept_name FROM departments WHERE id = :did; ------------------------------------------------------------------ ------------------------- COURSES TABLE ------------------------- ------------------------------------------------------------------ -- (none defined yet) ------------------------------------------------------------------ ------------------------- CLASSES TABLE ------------------------- ------------------------------------------------------------------ -- Add a class to the classes table. PROCEDURE add_class ( :class_no INTEGER, :dept_no INTEGER, :course_no INTEGER, :max_students INTEGER, :instr_id INTEGER, :quarter INTEGER, :year INTEGER, SQLCODE); INSERT INTO classes VALUES ( :class_no, :course_no, :dept_no, :max_students, null, -- building number and null, -- room not yet assigned :instr_id, :quarter, :year ); -- Drop a class. PROCEDURE delete_class ( :class_no INTEGER, SQLCODE); DELETE FROM classes WHERE class_number = :class_no; -- Get an ID number for a new class. -- A class is an instance of a course. -- Use the class_number_seq sequence generator. PROCEDURE get_new_class_id ( :new_id INTEGER, SQLCODE); SELECT class_number_seq.nextval INTO :new_id FROM dual; ------------------------------------------------------------------ ---------------------- ENROLLMENT TABLE ------------------------- ------------------------------------------------------------------ -- Declare a cursor to return information about all -- classes a given student has or is enrolled in his -- or her college career. -- In this college, letter grades are assigned -- numbers, in the following format: -- A 4.0 -- B+ 3.5 -- B 3.0 -- C+ 2.5 -- C 2.0 -- D 1.0 -- F 0.0 DECLARE get_enroll_curs CURSOR FOR SELECT courses.name, classes.instructor, classes.year, classes.quarter, enrollment.grade, enrollment.comments FROM courses, classes, enrollment WHERE courses.id = classes.course_number AND classes.class_number = enrollment.class_no AND enrollment.student_id = :sid -- Define a procedure to open the GET_ENROLL_CURS cursor. -- Note that this procedure requires an IN parameter to set -- the student ID number (sid). PROCEDURE open_get_enroll_curs ( :sid INTEGER, SQLCODE); OPEN GET_ENROLL_CURS; -- CLOSE the get_enroll_curs cursor PROCEDURE close_get_enroll_curs ( SQLCODE); CLOSE get_enroll_curs; -- FETCH from the courses, classes, and enrollment table -- using the get_enroll_curs cursor PROCEDURE get_enroll_by_student ( :course_name CHARACTER(38), :instructor INTEGER, :year INTEGER, :quarter INTEGER, :grade REAL, :grade_ind SMALLINT, :comments CHARACTER(255), SQLCODE); FETCH get_enroll_curs INTO :course_name, :instructor, :year, :quarter, :grade INDICATOR :grade_ind, :comments; -- Enroll a student in a class. PROCEDURE enroll_student_in_class ( :class_number INTEGER, :sid INTEGER, SQLCODE); INSERT INTO enrollment VALUES ( enrollment_seq.nextval, :class_number, :sid, null, -- no grade yet ' ' -- no comments yet ); ------------------------------------------------------------------ ------------------------ UTILITY PROCEDURES --------------------- ------------------------------------------------------------------ -- Commit a transaction. PROCEDURE do_commit( SQLCODE); COMMIT WORK; -- Connect to a database PROCEDURE do_connect ( :dbname CHARACTER(14), :username CHARACTER(14), :passwd CHARACTER(14), SQLCODE); CONNECT TO :dbname USER :username USING :passwd; -- Disconnect PROCEDURE do_disconnect ( SQLCODE); DISCONNECT CURRENT; -- Roll a transaction back. PROCEDURE do_rollback ( SQLCODE); ROLLBACK WORK;
The sample stored package defined below can be used to demonstrate how to call a stored procedure from an Ada application. The package source is GPAPKG.SQL, andit is in your demo directory. See the program "DEMCALSP.A" on page 6-40 , written in the host language, that calls the GET_GPA_IF procedure in this package. Each of these host programs is also on-line, in your demo directory.
-- Create the specification for a package -- that contains the GET_GPA stored procedure. -- Use the WITH INTERFACE clause so that -- the package procedure can be called from a 3GL. -- Note that the procedure parameters have PL/SQL -- datatypes, but in the WITH INTERFACE clause -- SQL datatypes must be used, and they must be -- constrained if required (for example, CHARACTER(15)). -- The WITH INTERFACE clause allows you to -- specify error-handling parameters, such as SQLSTATE, -- as well as indicator parameters. These are filled -- in as the procedure executes. -- The calling host 3GL application calls the procedure -- named in the WITH INTERFACE clause. This -- would usually be given the same name as the procedure -- in the body. Here it is given a different name, to -- demonstrate that (1) you can do this, and (2) it is -- the WITH INTERFACE clause name that gets -- generated in the interface procedure as the procedure to call. -- Note that this package will create -- the package and procedure names in uppercase. So the -- module compiler will generate interface procedures that have -- the names -- in uppercase, which means that you must call them using -- upper case in your host program. If you prefer lowercase, -- simply change the package and procedure names to be -- quoted lowercase, for example: -- -- CREATE OR REPLACE PACKAGE "gpa_pkg" AS ... CREATE OR REPLACE PACKAGE GPA_PKG AS PROCEDURE GET_GPA(student_id IN NUMBER, student_last_name IN OUT CHARACTER, gpa OUT NUMBER) WITH INTERFACE PROCEDURE GET_GPA_IF (student_id INTEGER, student_last_name CHARACTER(15) INDICATOR sname_ind, sname_ind SMALLINT, gpa REAL, sqlstate CHARACTER(5), sqlcode INTEGER); END; -- Create the package body. There is no need for -- a WITH INTERFACE clause in the body. -- The GET_GPA procedure computes the cumulative GPA -- over all courses that the student has taken, and returns -- the computed value. If the student has received no -- grades yet, a null is returned (through the indicator -- parameter). CREATE OR REPLACE PACKAGE BODY GPA_PKG AS PROCEDURE GET_GPA(student_id IN NUMBER, student_last_name IN OUT CHARACTER, gpa OUT NUMBER) IS -- The cursor selects all the classes that -- the student has enrolled in. CURSOR get_enroll_curs(sid IN NUMBER) IS SELECT enrollment.grade FROM enrollment WHERE enrollment.student_id = sid AND enrollment.grade IS NOT NULL; -- Declare local variables. -- gpa_temp needed because gpa is an OUT parameter n NUMBER := 0; grade NUMBER; gpa_temp NUMBER := 0; BEGIN gpa := 0.0; -- Get the last name; -- if not found, the no_data_found -- predefined exception is raised. SELECT last_name INTO student_last_name FROM students WHERE id = student_id; -- Otherwise, open the cursor and FETCH. open get_enroll_curs(student_id); loop FETCH get_enroll_curs INTO grade; exit when get_enroll_curs%notfound; gpa_temp := gpa_temp + grade; n := n + 1; end loop; close get_enroll_curs; if n > 0 then gpa := gpa_temp / n; end if; exception -- The SQLCODE parameter in the WITH INTERFACE -- parameter list will not be set to +100 because -- the exception is handled here, but the indicator -- variable will be set to -1 because of the null -- assignment. when no_data_found then student_last_name := null; end GET_GPA; END;
-- Module Language demonstration program for Ada. -- For an explanation of the tables that are accessed -- and the Module Language procedures that -- are called in this program, see Sample Programs. -- -- The module language code that contains the procedures called -- by this program, and SQL scripts to create and populate -- the tables used, are included in the source distribution. -- with -- The required SQL standard package. sql_standard, -- The module language procedures package. demomod, -- Other I/O packages... text_io, float_text_io, integer_text_io; use -- use the standard I/O packages. text_io, sql_standard, float_text_io, integer_text_io; procedure DEMOHOST is -- instantiate new packages for I/O on SQL_STANDARD datatypes package STD_INT_IO is new text_io.integer_io(SQL_STANDARD.INT); use STD_INT_IO; package SQLCODE_IO is new text_io.integer_io(SQL_STANDARD.SQLCODE_TYPE); use SQLCODE_IO; package STD_SMALLINT_IO is new text_io.integer_io(SQL_STANDARD.SMALLINT); use STD_SMALLINT_IO; package STD_FLOAT_IO is new text_io.float_io(SQL_STANDARD.REAL); use STD_FLOAT_IO; -- declare main procedure variables and exceptions -- handle command input type COMMAND is (AC, AS, DC, DS, ES, SE, SS, US, HELP, QUIT, BYE); package COMMAND_IO is new text_io.enumeration_io(COMMAND); use COMMAND_IO; COM_LINE : COMMAND; -- make SQLCODE global since program structure allows this SQLCODE : SQL_STANDARD.SQLCODE_TYPE; ANSWER : string(1..4); LENGTH : integer; SERVICE_NAME : SQL_STANDARD.CHAR(1..14); USERNAME : SQL_STANDARD.CHAR(1..14); PASSWORD : SQL_STANDARD.CHAR(1..14); -- declare top-level exceptions CONNECT_ERROR : exception; SQLCODE_ERROR : exception; -- define procedures -- get a user command procedure GET_COMMAND(CMD : out COMMAND) is begin loop begin new_line(2); put("Select an option: "); get(CMD); return; exception when data_error => put_line (ascii.bel & "Invalid option, try again."); end; end loop; end GET_COMMAND; procedure MENU is begin new_line(5); put_line(" *** COLLEGE RECORDS ***"); new_line; put_line("AC - add a class to curriculum"); put_line("AS - enroll a new student in the college"); put_line("DC - drop a class from curriculum"); put_line("DS - drop a student"); put_line("ES - enroll a student in a class"); put_line("SE - show complete enrollment records"); put_line("SS - show all students"); put_line("US - update a student's record"); put_line("HELP - redisplay this menu"); put_line("QUIT - quit program"); new_line(3); end MENU; -- Procedure to get an integer value from the user, -- prompting first. procedure GET_STANDARD_INT(PROMPT : string; VALUE : out SQL_STANDARD.INT) is begin put(prompt); get(integer(VALUE)); skip_line; end GET_STANDARD_INT; -- Get a text string from the user, prompting first. -- The string is blank-padded. procedure GET_STANDARD_TEXT(PROMPT : in string; VALUE : out SQL_STANDARD.CHAR; LENGTH : in out integer) is OLD_LENGTH : integer; begin OLD_LENGTH := LENGTH; put(PROMPT); VALUE := (1..LENGTH => ' '); get_line(string(VALUE), LENGTH); if LENGTH = OLD_LENGTH then skip_line; end if; end GET_STANDARD_TEXT; -- The following procedures, all beginning with the prefix -- "CALL_", are called from the main procedure, -- and in turn call Module Language procedures, defined -- in the DEMOMOD.mad file. procedure CALL_ADD_CLASS is CLASS_NUMBER : SQL_STANDARD.INT; DEPARTMENT_NUMBER : SQL_STANDARD.INT; COURSE_NUMBER : SQL_STANDARD.INT; MAX_ENROLLMENT : SQL_STANDARD.INT; INSTRUCTOR_ID : SQL_STANDARD.INT range 1000..SQL_STANDARD.INT'last; QUARTER : SQL_STANDARD.INT range 1..4; YEAR : SQL_STANDARD.INT range 1900..2100; begin new_line(2); put_line("Add a new class to the schedule"); new_line(2); DEMOMOD.GET_NEW_CLASS_ID(CLASS_NUMBER, SQLCODE); if SQLCODE /= 0 then put("Cannot generate new class number. CODE is "); put(SQLCODE); new_line; put_line(" Call your database administrator."); return; else put("New class number is "); put(CLASS_NUMBER); new_line; end if; loop begin new_line; GET_STANDARD_INT ("Enter dept ID: ", DEPARTMENT_NUMBER); GET_STANDARD_INT ("Enter course ID number: ", COURSE_NUMBER); GET_STANDARD_INT ("maximum enrollment: ", MAX_ENROLLMENT); GET_STANDARD_INT ("instructor ID number: ", INSTRUCTOR_ID); GET_STANDARD_INT ("quarter (1=spring, 2=summer, ...: ", QUARTER); GET_STANDARD_INT("year (4 digits please): ", YEAR); DEMOMOD.ADD_CLASS(CLASS_NUMBER, COURSE_NUMBER, DEPARTMENT_NUMBER, MAX_ENROLLMENT, INSTRUCTOR_ID, QUARTER, YEAR, SQLCODE); if SQLCODE /= 0 then put("Error adding class. CODE is "); put(SQLCODE); new_line; else put_line("New class added."); end if; exit; exception when CONSTRAINT_ERROR => new_line; put_line("Last input not valid. Try again."); new_line; end; end loop; end CALL_ADD_CLASS; procedure CALL_ADD_STUDENT is ERROR_COUNT : integer := 0; SIZE : integer; NEW_ID : SQL_STANDARD.INT; MI_IND : SQL_STANDARD.SMALLINT; TEMP_STRING : string(1..80); FIRST_NAME : SQL_STANDARD.CHAR(1..15); LAST_NAME : SQL_STANDARD.CHAR(1..15); MI : SQL_STANDARD.CHAR(1..3); DATE_OF_BIRTH : SQL_STANDARD.CHAR(1..9); DOB_IND : SQL_STANDARD.SMALLINT; STATUS : SQL_STANDARD.CHAR(1..5); LENGTH : integer; begin new_line(2); put_line("Add a new student to the database."); new_line(2); DEMOMOD.GET_NEW_STUDENT_ID(NEW_ID, SQLCODE); if SQLCODE /= 0 then put_line("Cannot generate ID number for student."); put("CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); return; end if; skip_line; loop begin new_line; LENGTH := 15; GET_STANDARD_TEXT(" Last name: ", LAST_NAME, LENGTH); LENGTH := 15; GET_STANDARD_TEXT(" First name: ", FIRST_NAME, LENGTH); LENGTH := 3; GET_STANDARD_TEXT(" Middle initial: ", MI, LENGTH); if LENGTH = 0 then MI_IND := -1; else MI_IND := 0; end if; LENGTH := 9; GET_STANDARD_TEXT(" Date of birth (DD-MON-YY): ", DATE_OF_BIRTH, LENGTH); if LENGTH = 0 then DOB_IND := -1; else DOB_IND := 0; end if; LENGTH := 5; GET_STANDARD_TEXT(" Status (FT, PT, JYA, ...): ", STATUS, LENGTH); DEMOMOD.ADD_STUDENT(LAST_NAME, FIRST_NAME, MI, MI_IND, NEW_ID, STATUS, DATE_OF_BIRTH, DOB_IND, SQLCODE); if SQLCODE /= 0 then new_line; put("Error adding student. CODE is "); put(SQLCODE, width => 5); else new_line; put("Student added. ID number is"); put(NEW_ID, width => 6); end if; new_line(3); return; exception when constraint_error => ERROR_COUNT := ERROR_COUNT + 1; if ERROR_COUNT > 3 then put_line ("Too many errors. Back to main program."); exit; end if; put_line("Invalid value. Try again."); when others => put_line("Data error or other error."); exit; end; end loop; end CALL_ADD_STUDENT; procedure CALL_DROP_CLASS is CLASS_NUMBER : SQL_STANDARD.INT; begin new_line(2); put_line("Drop a class"); new_line(2); GET_STANDARD_INT (" Enter class ID number: ", CLASS_NUMBER); DEMOMOD.DELETE_CLASS(CLASS_NUMBER, SQLCODE); if SQLCODE /= 0 then new_line; put("Error dropping the class. CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); else put_line("Class dropped."); end if; end CALL_DROP_CLASS; procedure CALL_DROP_STUDENT is LAST_NAME, FIRST_NAME : SQL_STANDARD.CHAR(1..15); MI : SQL_STANDARD.CHAR(1..3); STUDENT_ID : SQL_STANDARD.INT; ANSWER : string(1..12); ALEN : integer; begin new_line(2); put_line("Drop a student from the college."); new_line(2); GET_STANDARD_INT (" Enter student ID number: ", STUDENT_ID); DEMOMOD.GET_STUDENT_NAME_FROM_ID(STUDENT_ID, LAST_NAME, FIRST_NAME, MI, SQLCODE); if SQLCODE /= 0 then new_line; put("Error getting student information. CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); return; end if; put_line("Student's name is--"); put_line(string(FIRST_NAME & MI & LAST_NAME)); put("Do you really want to do this? "); get_line(ANSWER, ALEN); if ANSWER(1) = 'Y' or ANSWER(1) = 'y' then DEMOMOD.DELETE_STUDENT(STUDENT_ID, SQLCODE); if SQLCODE /= 0 then put_line("Error dropping student. CODE is "); put(SQLCODE); return; else put_line (string(LAST_NAME) & " has been dropped!"); end if; else put_line("OK, student will not be dropped."); end if; end CALL_DROP_STUDENT; procedure CALL_ENROLL_STUDENT is CLASS_NUMBER, STUDENT_ID : SQL_STANDARD.INT; LAST_NAME, FIRST_NAME : SQL_STANDARD.CHAR(1..15); MI : SQL_STANDARD.CHAR(1..3); begin new_line(2); put_line("Enroll a student in a class."); new_line(2); GET_STANDARD_INT(" Enter student ID: ", STUDENT_ID); GET_STANDARD_INT(" Enter class ID: ", CLASS_NUMBER); DEMOMOD.GET_STUDENT_NAME_FROM_ID(STUDENT_ID, LAST_NAME, FIRST_NAME, MI, SQLCODE); if SQLCODE /= 0 then new_line; put_line("That student ID does not exist."); put("CODE is "); put(SQLCODE); new_line; put_line("Recheck and try again."); else put_line (" The student's name is " & string(LAST_NAME)); put(" Enrolling..."); DEMOMOD.ENROLL_STUDENT_IN_CLASS(CLASS_NUMBER, STUDENT_ID, SQLCODE); if SQLCODE /= 0 then new_line; put("Error occurred enrolling student. CODE is "); put(SQLCODE); new_line; put_line("Check class ID number and try again."); else put_line("done"); end if; end if; end CALL_ENROLL_STUDENT; procedure CALL_SHOW_ENROLLMENT is COURSE_NAME : SQL_STANDARD.CHAR(1..38); INSTR_ID, SID, YEAR, QUARTER : SQL_STANDARD.INT; GRADE, GPA : SQL_STANDARD.REAL; GRADE_IND : SQL_STANDARD.SMALLINT; COMMENTS : SQL_STANDARD.CHAR(1..255); GRADE_COUNT, ROW_COUNT : integer; begin new_line(2); put_line("Show enrollment in all courses for a student."); new_line(2); GET_STANDARD_INT (" Enter student ID number (try 1000): ", SID); DEMOMOD.OPEN_GET_ENROLL_CURS(SID, SQLCODE); if SQLCODE /= 0 then new_line; put("Error opening cursor. CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); else GPA := 0.0; GRADE_COUNT := 0; ROW_COUNT := 0; put("COURSE TITLE "); put_line("INSTR ID YEAR QUARTER GRADE"); loop DEMOMOD.GET_ENROLL_BY_STUDENT(COURSE_NAME, INSTR_ID, YEAR, QUARTER, GRADE, GRADE_IND, COMMENTS, SQLCODE); if SQLCODE = 100 then exit; elsif SQLCODE /= 0 then new_line; put_line("Error fetching data. CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); exit; else ROW_COUNT := ROW_COUNT + 1; put(string(COURSE_NAME)); put(INSTR_ID, width => 6); put(YEAR, width => 11); put(QUARTER, width => 6); if GRADE_IND >= 0 then GRADE_COUNT := GRADE_COUNT + 1; GPA := GPA + GRADE; put(GRADE, fore => 7, aft => 2, exp => 0); end if; end if; new_line; end loop; if GRADE_COUNT > 0 and SQLCODE = 100 then new_line; GPA := GPA / REAL(GRADE_COUNT); put("Overall GPA is "); put(GPA, fore => 1, aft => 2, exp => 0); end if; DEMOMOD.CLOSE_GET_ENROLL_CURS(SQLCODE); if SQLCODE /= 0 then new_line; put("Error closing cursor. CODE is "); put(SQLCODE); new_line; end if; end if; end CALL_SHOW_ENROLLMENT; procedure CALL_SHOW_STUDENTS is LAST_NAME, FIRST_NAME : SQL_STANDARD.CHAR(1..15); MI : SQL_STANDARD.CHAR(1..3); INSTR_LAST_NAME : SQL_STANDARD.CHAR(1..15); INSTR_FIRST_NAME : SQL_STANDARD.CHAR(1..15); INSTR_MI : SQL_STANDARD.CHAR(1..3); MI_IND, INSTR_MI_IND : SQL_STANDARD.SMALLINT; SID, MAJOR, ADVISOR, INSTR : SQL_STANDARD.INT; MAJOR_IND, ADVISOR_IND : SQL_STANDARD.SMALLINT; STATUS : SQL_STANDARD.CHAR(1..5); begin new_line(2); put_line(" ----- STUDENTS CURRENTLY ENROLLED -----"); new_line(2); put("LAST NAME FIRST NAME MI ID NO STATUS"); put_line(" MAJOR ADVISOR"); DEMOMOD.OPEN_GET_STUDENTS_CURS(SQLCODE); if SQLCODE /= 0 then new_line; put("Error opening cursor. CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); return; end if; loop DEMOMOD.GET_ALL_STUDENTS(LAST_NAME, FIRST_NAME, MI, MI_IND, SID, STATUS, MAJOR, MAJOR_IND, ADVISOR, ADVISOR_IND, SQLCODE); if SQLCODE = 100 then exit; elsif SQLCODE /= 0 then new_line; put_line("Error fetching data. CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); exit; else put(string(LAST_NAME)); put(string(FIRST_NAME)); put(string(MI)); put(SID, width => 5); put(" "); put(string(STATUS)); put(" "); if MAJOR_IND < 0 then put("(NONE)"); else put(MAJOR); end if; if ADVISOR_IND = 0 then DEMOMOD.GET_INSTRUCTOR_NAME_FROM_ID (ADVISOR, INSTR_LAST_NAME, INSTR_FIRST_NAME, INSTR_MI, INSTR_MI_IND, SQLCODE); if SQLCODE = 0 then put(" " & string(INSTR_LAST_NAME)); else put("[err = "); put(SQLCODE); put("]"); end if; else put(" (NONE)"); end if; end if; new_line; end loop; DEMOMOD.CLOSE_GET_STUDENTS_CURS(SQLCODE); if SQLCODE /= 0 then new_line; put("Error closing cursor. CODE is "); put(SQLCODE); new_line; put_line("Call your database administrator."); new_line; end if; end CALL_SHOW_STUDENTS; procedure CALL_UPDATE_RECORD is SID, ADVISOR, MAJOR : SQL_STANDARD.INT; GRAD_DATE : SQL_STANDARD.CHAR(1..9); ADVISOR_IND, MAJOR_IND : SQL_STANDARD.SMALLINT; GRAD_DATE_IND : SQL_STANDARD.SMALLINT; LENGTH : integer; LAST_NAME : SQL_STANDARD.CHAR(1..20); FIRST_NAME : SQL_STANDARD.CHAR(1..20); MI : SQL_STANDARD.CHAR(1..3); begin new_line(2); put_line("Update a student's records."); new_line(2); GET_STANDARD_INT(" Enter student ID number: ", SID); DEMOMOD.GET_STUDENT_NAME_FROM_ID(SID, LAST_NAME, FIRST_NAME, MI, SQLCODE); if SQLCODE /= 0 then new_line; put_line("That student ID does not exist."); new_line; put_line("Recheck and try again."); return; else put_line (" The student's last name is " & string(LAST_NAME)); new_line; end if; put(" Change major? If so, enter new department "); GET_STANDARD_INT("number. If not, enter 0: ", MAJOR); if MAJOR = 0 then MAJOR_IND := -1; else MAJOR_IND := 0; end if; put(" New advisor? If so, enter the instructor ID "); GET_STANDARD_INT("number. If not, enter 0: ", ADVISOR); if ADVISOR = 0 then ADVISOR_IND := -1; else ADVISOR_IND := 0; end if; put_line (" Has the student graduated. If so, enter date (DD-MON-YY)"); LENGTH := 9; GET_STANDARD_TEXT (" If not, press RETURN: ", GRAD_DATE, LENGTH); if LENGTH = 0 then GRAD_DATE_IND := -1; else GRAD_DATE_IND := 0; end if; DEMOMOD.UPDATE_STUDENT(SID, MAJOR, MAJOR_IND, ADVISOR, ADVISOR_IND, GRAD_DATE, GRAD_DATE_IND, SQLCODE); if SQLCODE /= 0 then new_line; put("Error updating records. Code is "); put(SQLCODE); new_line; put_line("Call your database administrator."); else new_line; put_line("Records updated. "); end if; end CALL_UPDATE_RECORD; ------------------------------------------------------------------ --------------------- main --------------------------------------- ------------------------------------------------------------------ begin SQLCODE_IO.default_width := 6; SERVICE_NAME := "inst1_alias "; USERNAME := "modtest "; PASSWORD := "yes "; DEMOMOD.DO_CONNECT(SERVICE_NAME, USERNAME, PASSWORD, SQLCODE); if SQLCODE /= 0 then raise connect_error; end if; put_line("Connected to ORACLE."); new_line; MENU; loop GET_COMMAND(COM_LINE); case COM_LINE is when AC => CALL_ADD_CLASS; when AS => CALL_ADD_STUDENT; when DC => CALL_DROP_CLASS; when DS => CALL_DROP_STUDENT; when ES => CALL_ENROLL_STUDENT; when SE => CALL_SHOW_ENROLLMENT; when SS => CALL_SHOW_STUDENTS; when US => CALL_UPDATE_RECORD; when HELP => MENU; when QUIT | BYE => skip_line; new_line(5); put("Commit all changes [yn]: "); LENGTH := 4; get_line(ANSWER, LENGTH); if (ANSWER(1..1) = "y") then DEMOMOD.DO_COMMIT(SQLCODE); put_line("Changes committed."); else DEMO_MOD.DO_ROLLBACK; put_line("Changes discarded."); end if; new_line(2); put_line("G'Day!"); new_line(4); exit; end case; end loop; DEMOMOD.DO_DISCONNECT(SQLCODE); if SQLCODE /= 0 then put("Error disconnecting. SQLCODE is "); put(SQLCODE); put_line("Exiting anyway."); end if; exception when CONNECT_ERROR => put_line("Error connecting to ORACLE."); new_line(4); when SQLCODE_ERROR => put("Error fetching data. CODE is "); put(sqlcode); new_line(4); DEMOMOD.DO_DISCONNECT(SQLCODE); when others => put_line("Unhandled error occurred. Fix the program!"); new_line(4); end DEMOHOST;
-- demcalsp.a -- -- Sample program that demonstrates how to call a -- database stored procedure using the WITH INTERFACE -- PROCEDURE clause. -- -- The stored package is in the file GPAPKG.SQL. -- Include the required specs. Demomod must be included -- since it contains the connect and disconnect procedures. with TEXT_IO, SQL_STANDARD, GPA_PKG, DEMOMOD, FLOAT_TEXT_IO, INTEGER_TEXT_IO; use TEXT_IO, SQL_STANDARD, FLOAT_TEXT_IO, INTEGER_TEXT_IO; procedure DEMCALSP is -- Define the required I/O packages for SQL_STANDARD. package STD_INT_IO is new TEXT_IO.INTEGER_IO(SQL_STANDARD.INT); use STD_INT_IO; package SQLCODE_IO is new TEXT_IO.INTEGER_IO(SQL_STANDARD.SQLCODE_TYPE); use SQLCODE_IO; package STD_SMALLINT_IO is new TEXT_IO.INTEGER_IO(SQL_STANDARD.SMALLINT); use STD_SMALLINT_IO; package STD_FLOAT_IO is new TEXT_IO.FLOAT_IO(SQL_STANDARD.REAL); use STD_FLOAT_IO; STUDENT_ID : SQL_STANDARD.INT; STUDENT_LAST_NAME : SQL_STANDARD.CHAR(1..15); NAME_IND : SQL_STANDARD.SMALLINT; GPA : SQL_STANDARD.REAL; PASSWORD : SQL_STANDARD.CHAR(1..12); SERVICE_NAME : SQL_STANDARD.CHAR(1..12); USERNAME : SQL_STANDARD.CHAR(1..12); SQLCODE : SQL_STANDARD.SQLCODE_TYPE; SQLSTATE : SQL_STANDARD.SQLSTATE_TYPE; CONNECT_ERROR : exception; SQLCODE_ERROR : exception; begin PASSWORD := "yes "; SERVICE_NAME := "inst1_alias "; USERNAME := "modtest "; DEMOMOD.DO_CONNECT(SERVICE_NAME, USERNAME, PASSWORD, SQLCODE); if SQLCODE /= 0 then raise CONNECT_ERROR; end if; new_line(2); put_line("Get grade point average--"); new_line; loop begin new_line; put("Enter student ID number (try 1000) (0 to quit): "); get(STUDENT_ID); new_line; exit when STUDENT_ID = 0; -- Call the stored procedure. GPA_PKG.GET_GPA_IF(STUDENT_ID, STUDENT_LAST_NAME, NAME_IND, GPA, SQLSTATE, SQLCODE); if SQLCODE /= 0 then raise SQLCODE_ERROR; end if; if NAME_IND = 0 then new_line; put("Last name is " & string(STUDENT_LAST_NAME)); put("Overall GPA is"); put(GPA, fore => 4, aft => 2, exp => 0); else put("There is no student with ID number"); put(STUDENT_ID, width => 5); new_line; end if; exception when SQLCODE_ERROR => new_line; put("Error fetching data, SQLCODE is "); put(SQLCODE, width => 5); end; end loop; -- Disconnect from the server. DEMOMOD.DO_DISCONNECT(SQLCODE); if SQLCODE /= 0 then put("Error disconnecting. SQLCODE is "); put(SQLCODE); put_line("Exiting anyhow."); end if; exception when CONNECT_ERROR => put("Error connecting to Oracle."); end DEMCALSP;
