Release 8.0
A54660_01
 Library |
 Product |
 Contents |
 Index |
| Programmer's
Guide to SQL*Module for Ada Release 8.0 A54660_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
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 studend_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 shipped as GPAPKG.SQL, and is in your demo directory. On page 6-33 there is a sample program called demcalsp, 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 ");
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.");
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;
|
 Copyright © 1997 Oracle Corporation. All Rights Reserved. |
|