Skip Headers
Oracle® SQL*Module for Ada Programmer's Guide
11g Release 2 (11.2)

Part Number E10827-01
Go to Documentation Home
Home
Go to Book List
Book List
Go to Table of Contents
Contents
Go to Index
Index
Go to Master Index
Master Index
Go to Feedback page
Contact Us

Go to previous page
Previous
Go to next page
Next
PDF · Mobi · ePub

6 Demonstration Programs

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:

The SQL_STANDARD Package

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.

SQLCODE

The standard type of the SQLCODE parameter for Ada is SQL_STANDARD.SQLCODE_TYPE.

SQLSTATE

The standard type of the SQLSTATE parameter for Ada is SQL_STANDARD.SQLSTATE_TYPE. It is a five-character string.

Sample Programs

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

Sample Tables

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.

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 re-create 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 

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

INSTRUCS.SQL

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');

STUDENTS.SQL

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

COURSES.SQL

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');

EMROLMNT.SQL

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, ' ');

Module Language Sample Program

-- 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;

Calling a Stored Procedure

The sample stored package defined can be used to demonstrate how to call a stored procedure from an Ada application. The package source is GPAPKG.SQL, and it is in your demo directory. See the program "DEMCALSP.A", 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 enables 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;

Sample Applications

This section contains sample applications that may aid development.

DEMOHOST.A

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

-- 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;