-- Copyright © Oracle Corporation 1995.  All Rights Reserved.
--  ABSTRACT:
--
--      This program demonstrates the creation of a report from an Oracle Rdb
--	database using DEC Ada and the module language feature of the SQL
--      interface to Oracle Rdb.
--	The name of the file containing the module language procedures is
--	SQL_REPORT.SQLMOD.
--
--	In this sample, the program uses a read only transaction to attach 
--	the database and opens an RMS file for output.  The Ada TEXT_IO 
--	facility is used for all output to de-emphasize the I/O aspects of the
--	report processing.  A cursor is opened using two views from the 
--	database to construct the report detail records.  Rows are fetched
--	from the database until the cursor end-of-stream is encountered.
--	The records are formatted and written to the report file with
--	appropriate totals, page and report breaks.  The transaction is then
--	rolled back and the report file closed.
-- 



with CONDITION_HANDLING;
with STARLET;
with SYSTEM; use SYSTEM;
with TEXT_IO; use TEXT_IO;

procedure SQL_REPORT is

-- The following declarations are for SQL call error handling
    SQL_RETURN_STATUS : integer;
    SQL_SUCCESS : constant integer := 0;
    STREAM_EOF : constant integer := 100;
    DEADLOCK : constant integer := -913;
    LOCK_CONFLICT : constant integer := -1003;
    DEADLOCK_ERROR, LOCK_CONFLICT_ERROR, UNEXPECTED_ERROR : exception;

-- The following declarations are for VMS system service call error handling
    VMS_RETURN_STATUS : condition_handling.cond_value_type;
    IVTIME_ERROR : exception;

-- String subtypes
    subtype STRING4 is string(1..4);
    subtype STRING5 is string(1..5);
    subtype STRING10 is string(1..10);
    subtype STRING14 is string(1..14);

-- Variables for main program use

    -- Host variables for SQL calls
    EMPLOYEE_ID : string5;
    LAST_NAME : string14;
    FIRST_NAME : string10;
    JOB_CODE : string4;
    DEPARTMENT_CODE : string4;
    SALARY_AMOUNT : F_float;
    -- Date string for report headers
    CURRENT_DATE : string(1..12);
    -- Accumulators for salary totals
    JOB_CODE_SALARY_AMOUNT : F_float := 0.0;
    DEPT_SALARY_AMOUNT : F_float := 0.0;
    TOTAL_SALARY_AMOUNT : F_float := 0.0;
    -- Job code break indicator
    JOB_CODE_BREAK : boolean := FALSE;
    -- Variables to save previous codes for break processing
    LAST_JOB_CODE : string4 := (others => ' ');
    LAST_DEPARTMENT_CODE : string4 := (others => ' ');

-- Package instantiation of integer_io and float_io in text_io for integer and
-- real number output
    subtype int is integer;
    subtype real is f_float;
    package INT_IO is new text_io.integer_io(int);
    package REAL_IO is new text_io.float_io(real);

-- Declarations needed for the report file
    sql_report : file_type;
    
-- SQL module language procedure declarations
-- including the INTERFACE and IMPORT_PROCEDURE pragmas
    procedure SET_TRANSACTION(SQLCODE : out integer);
    procedure OPEN_CURSOR(SQLCODE : out integer);
    procedure FETCH_REPORT_RECORD(SQLCODE : out integer;
                                  EMPLOYEE_ID : out string5;
                                  LAST_NAME : out string14;
                                  FIRST_NAME : out string10;
                                  JOB_CODE : out string4;
                                  DEPARTMENT_CODE : out string4;
                                  SALARY_AMOUNT : out F_float);
    procedure ROLLBACK_TRANSACTION(SQLCODE: out integer);

    pragma INTERFACE(SQL, SET_TRANSACTION);
    pragma INTERFACE(SQL, OPEN_CURSOR);
    pragma INTERFACE(SQL, FETCH_REPORT_RECORD);
    pragma INTERFACE(SQL, ROLLBACK_TRANSACTION);

--------------------------------------------------------------------------------
-- Procedures used by the main program
--------------------------------------------------------------------------------

procedure PAGE_HEADER is
-- This procedure prints the page headers
begin
-- Format and print the page header lines
    set_col(26); put("SALARY DATA");
    set_col(64); put_line(current_date);
    set_col(24); put("BY DEPARTMENTS");
    set_col(64); put("Page: "); int_io.put(integer(page),2); new_line;
end PAGE_HEADER;

procedure JOB_CODE_HEAD is
-- This procedure prints the job code headers
begin
-- Format and print the header lines
    new_line(2);
    set_col(10); put("Job");
    set_col(62); put_line("Salary");
    put("Dept");
    set_col(10); put("Code");
    set_col(18); put("Id");
    set_col(24); put("Last Name");
    set_col(40); put("First Name");
    set_col(62); put_line("Amount");
    put("----");
    set_col(10); put("----");
    set_col(18); put("-----");
    set_col(24); put("--------------");
    set_col(40); put("----------");
    set_col(59); put_line("--------------");
-- Clear the job code break indicator
    job_code_break := FALSE;
end JOB_CODE_HEAD;

procedure JOB_CODE_FOOT is
-- This procedure prints the job code total
begin
    if line > 57 then  -- no room on current page for the total
	new_page;
	page_header;
    end if;
-- Format and print the job code total
    new_line;
    set_col(59); put_line("--------------");
    set_col(30); put(last_job_code);
    set_col(35); put("Salary Total in");
    set_col(51); put(last_department_code);
    set_col(55); put(":");
    set_col(59); put("$"); real_io.put(job_code_salary_amount,7,2,0);
    new_line;
-- Clear the job code salary total
    job_code_salary_amount := 0.0;
-- Set the job code break inidicator
    job_code_break := TRUE;
end JOB_CODE_FOOT;
 
procedure DEPT_CODE_FOOT is
-- This procedure prints the department total
begin
    if line > 57 then  -- no room on current page for total
	new_page;
	page_header;
    end if;
-- Format and print the total
    new_line;
    set_col(54); put_line("-----------------");
    set_col(25); put("Total Salary For");
    set_col(42); put(last_department_code);
    set_col(46); put(":");
    set_col(56); put("$"); real_io.put(dept_salary_amount,10,2,0);
    new_line;
-- Clear the department total
    dept_salary_amount := 0.0;
end DEPT_CODE_FOOT;



procedure DETAIL_LINE is
-- This procedure does most of the real work 
-- It checks for job_code and department_code breaks, controls most of the
-- page spacing and formats the detail lines
begin
    if (department_code /= last_department_code) and  -- department_code break
       (last_department_code /= "    ") then          -- but not for first code
	job_code_foot;                                -- job code total
	dept_code_foot;                               -- department code total
    else if (job_code /= last_job_code) and           -- job_code break
	    (last_job_code /= "    ") then            -- but not for first code
	    job_code_foot;                            -- job code total
	 end if;
    end if;

    if (line > 58) or                          -- need a new page 
       (line >= 54 and job_code_break) then    -- can't fit job code total and
                                               --  a detail line on this page
	new_page;            
	page_header;                           -- print page
	job_code_head;                         --  and job code headers
    else if line < 54 and job_code_break then  -- room for job code total and
	 job_code_head;                        --  and job code headers
         end if;
    end if;

-- Format and print the detail line
    put(department_code);
    set_col(10); put(job_code);
    set_col(18); put(employee_id);
    set_col(24); put(last_name);
    set_col(40); put(first_name);
    set_col(59); put("$"); real_io.put(salary_amount,7,2,0);
    new_line;
-- Save the job and department codes for break processing
    last_job_code := job_code;
    last_department_code := department_code;
-- Add the salary amount to the totals
    job_code_salary_amount := job_code_salary_amount + salary_amount;
    dept_salary_amount := dept_salary_amount + salary_amount;
    total_salary_amount := total_salary_amount + salary_amount;
end DETAIL_LINE;



procedure FINAL_FOOT is
-- This procedure prints the final total
begin
    new_line(2);
    set_col(54); put_line("-------------------");
    set_col(25); put("Grand Total Salaries:");
    set_col(55); put("$"); real_io.put(total_salary_amount,10,2,0);
    new_line;
end FINAL_FOOT;



-------------------------------------------------------------------------------
-- Main program
-------------------------------------------------------------------------------
begin

-- Call to SQL to start a transaction; check status on return
-- If successful, the database has been attached and we can go on
    set_transaction(sql_return_status);
    case sql_return_status is
    	when sql_success => null;
    	when deadlock => raise deadlock_error;
    	when lock_conflict => raise lock_conflict_error;
    	when others => raise unexpected_error;
    end case;

-- Initialization for the report; get date and open the report file

-- Get the date in ascii format using ASCTIM in package STARLET.  By leaving
-- the default value of zero in the optional TIMADR parameter, the default
-- value of zero in the optional CVTFLG parameter, and using a 12 byte string
-- for the TIMBUF parameter, only the current date is returned.  Check the
-- return status for errors.
    starlet.asctim(status => vms_return_status,
                   timbuf => current_date);
    if not condition_handling.success(vms_return_status)
	then raise ivtime_error; end if;

-- Create the report file and redirect output to the file
    create(file => sql_report, name => "sqlsamp.rpt");
    set_output(sql_report);

-- Open the cursor to form the desired record stream
    open_cursor(sql_return_status);
    case sql_return_status is
    	when sql_success => null;
    	when deadlock => raise deadlock_error;
    	when lock_conflict => raise lock_conflict_error;
    	when others => raise unexpected_error;
    end case;

-- Begin report by printing the initial headers
    page_header;
    job_code_head;

-- Main loop
    loop 

    -- Call to SQL to get a database record
    fetch_report_record(sql_return_status,employee_id,last_name,first_name,
                        job_code,department_code,salary_amount);

    -- Check return status
    case sql_return_status is
	-- If a record was returned, print a detail line
    	when sql_success => detail_line;
	-- If end of stream is encountered, print the final totals
    	when stream_eof => job_code_foot;
                           dept_code_foot;
                           final_foot;
                           exit;	-- and terminate the loop
	-- Any other status is an error condition
    	when others => raise unexpected_error;
    end case;
    end loop; -- end of main loop

-- Close the report file
    close(sql_report);

-- Rollback the transaction
    rollback_transaction(sql_return_status);
    	case sql_return_status is
    	    when sql_success => null;
    	    when others => raise unexpected_error;
    	end case;

exception

    -- Exception that may be raised by the ASCTIM routine
    when ivtime_error =>
	put_line("Invalid date format.  No report produced.");
    	rollback_transaction(sql_return_status);

    -- Exceptions that may be raised by SQL procedures
    when deadlock_error =>
	set_output(standard_output);
	put_line("Deadlock encountered.  No report produced.");
    	rollback_transaction(sql_return_status);
    when lock_conflict_error =>
	set_output(standard_output);
	put_line("Locking conflict.  No report produced.");
    	rollback_transaction(sql_return_status);
    when unexpected_error =>
	set_output(standard_output);
	put_line("Unexpected error.  No report produced.");
    	rollback_transaction(sql_return_status);

    -- Exceptions that may be raised by report file operations
    when status_error | layout_error | mode_error | name_error | use_error =>
	set_output(standard_output);
	put_line("Error in report file.  No report produced.");
	rollback_transaction(sql_return_status);

end SQL_REPORT;