(* Copyright © Oracle Corporation 1995.  All Rights Reserved. *)
(*  ABSTRACT:
* 
*  SQL_TERMINATE illustrates the use of SQL module language with DEC Pascal to
*  perform updates to an Oracle Rdb database and also illustrates a number of
*  error handling techniques.  The program is used to update the PERSONNEL
*  database when an employee leaves the company.  The user enters the ID number
*  and date of termination for the employee.  In one transaction, the program
*  verifies the ID number and makes the necessary changes in the EMPLOYEES,
*  JOB_HISTORY, and SALARY_HISTORY tables.
*
*  If verification and all changes execute successfully, the transaction is
*  committed.  The user may then start a transaction for another employee or
*  exit the program.  If an error occurs, the user receives an error message,
*  a rollback is done, and the user has the option of re-entering values or
*  exiting the program.
*
*  To keep the program simple, current information for an employee is not
*  brought to the screen and the characters and format of the date value input
*  by the user is not checked.
*
*  The name of the file containing the module language procedures is
*  SQL_TERMINATE_PAS.SQLMOD.
*
*) 

PROGRAM Sql_Terminate (INPUT,OUTPUT);

(*
*  Declare constants, types and variables for error handling
*)
CONST
    Id_Not_Found = 100;
    Deadlock = -913;
    Lock_Conflict = -1003;
TYPE
    $WORD = [WORD] 0..256;
    STR5 = PACKED ARRAY[1..5] OF CHAR;
    STR16 = PACKED ARRAY[1..16] OF CHAR;
    STR256 = PACKED ARRAY[1..256] OF CHAR;
VAR
    Msgid,Sql_Return_Status,Vms_Return_Status : INTEGER;
    Get_Error_Buffer : STR256;
    Get_Error_Len : $WORD;

(*
*  Declare constants, types and variables for program use
*)
CONST
    Update_Code = '1';
    Exit_Code = '8';
TYPE
    $QUAD = [QUAD,UNSAFE] RECORD
			    L0:UNSIGNED;
			    L1:INTEGER;
			  END;
VAR
    I : INTEGER;
    Release_Screen : CHAR;
    Employee_Id : STR5;
    Employee_Exists : BOOLEAN;
    Job_End : $QUAD;



(*
*  SQL module language procedure declarations
*)
    [EXTERNAL] PROCEDURE set_transaction(VAR SQLCODE : INTEGER); EXTERN;
    [EXTERNAL] PROCEDURE open_cursor(VAR SQLCODE : INTEGER;
                           VAR EMPLOYEE_ID : STR5); EXTERN;
    [EXTERNAL] PROCEDURE fetch_employees(VAR SQLCODE : INTEGER;
                           VAR EMPLOYEE_ID : STR5;
                           VAR STATUS_CODE : CHAR); EXTERN;
    [EXTERNAL] PROCEDURE get_date(VAR SQLCODE : INTEGER;
                           VAR JOB_END : $QUAD;
                           VAR END_DATE_TIME : STR16); EXTERN;
    [EXTERNAL] PROCEDURE update_employees(VAR SQLCODE : INTEGER); EXTERN;
    [EXTERNAL] PROCEDURE update_jobhist(VAR SQLCODE : INTEGER;
                           EMPLOYEE_ID : STR5;
                           JOB_END : $QUAD);
                         EXTERN;
    [EXTERNAL] PROCEDURE update_salhist(VAR SQLCODE : INTEGER;
                           EMPLOYEE_ID : STR5;
                           JOB_END : $QUAD);
                         EXTERN;
    [EXTERNAL] PROCEDURE commit_transaction(VAR SQLCODE : INTEGER); EXTERN;
    [EXTERNAL] PROCEDURE rollback_transaction(VAR SQLCODE: INTEGER); EXTERN;

(*
*  Functions and procedures used by the main program
*)

(*
*  This function returns an operator selection to the main program that is used
*  to control the main program loop.  In this function, the operator is prompted
*  for a selection until a valid choice is made.
*)
FUNCTION Main_Option_Input : CHAR;

VAR
    Valid_Code : BOOLEAN;
    Option_Entry : CHAR;

BEGIN
    Valid_Code := FALSE;
    WHILE NOT Valid_Code DO	(* Loop until a valid choice is entered *)
	BEGIN
	    FOR I := 1 TO 24 DO WRITELN;
	    WRITELN('INACTIVE STATUS UPDATE PROGRAM');
	    WRITELN;
	    WRITELN('Please enter a selection number.');
	    WRITELN('1 : to update an employee''s status to inactive');
	    WRITELN('8 : to exit this program');
	    WRITELN;
	    WRITE('Enter option: ');
	    READLN(Option_Entry);
	    WRITELN;

	    CASE Option_Entry OF
		Update_Code : Valid_Code := TRUE;   (* The only two valid *)
		Exit_Code : Valid_Code := TRUE;     (* choices            *)
		OTHERWISE 
		    WRITE('Invalid option.  ');
		    WRITE('Type C and press RETURN to continue. ');
		    READLN(Release_Screen);
	    END; (* of case *)
	END; (* of while *)

    Main_Option_Input := Option_Entry;   (* Return the selection to Main *)

END; (* Main_Option_Input *)



(*
*  Using equality to check the value of the SQLCODE (here returned in
*  Sql_Return_Status by SQL) assume that the severity level of errors will not
*  change.
*)
PROCEDURE Lock_Error_Check;

BEGIN
    IF (Sql_Return_Status = lock_conflict) OR
       (Sql_Return_Status = deadlock) THEN
	BEGIN
	    Rollback_Transaction(Sql_Return_Status);
	    FOR I := 1 TO 24 DO WRITELN;
	    WRITELN('A lock condition has occurred.');
	END
    ELSE
	BEGIN
	    (* Use the SQL provided procedure to retrieve error text *)
	    (* This program continues after these unexpected errors, *)
	    (* and allows the user to select the exit program option *)
	    (* on the menu.  Other programs may need to stop the     *)
	    (* program run automatically.                            *)
	    Rollback_Transaction(Sql_Return_Status);
	    FOR I := 1 TO 24 DO WRITELN;
	    WRITELN('This condition was not expected.');
	    WRITELN;
	END;

    WRITELN;
    WRITE('Type C and press RETURN to continue. ');
    READLN(Release_Screen);

END;	(* Lock_Error_Check *)



(*
*  This routine uses a system service to retrieve an error message from the 
*  customized, user-defined message file (SQL$PERSMSG).
*)
PROCEDURE Display_Atend_Message;

CONST
    Flags = 15;

BEGIN
    
    FOR I := 1 TO 24 DO WRITELN;
    WRITELN;
    WRITELN;
    WRITELN('Error occurred when attempting to fetch -- ',Employee_id);
    WRITELN;
    WRITELN('for employee ID -- ',Employee_Id);
    WRITELN;
    WRITE('Type C and press RETURN to continue. ');
    READLN(Release_Screen);

END;	(* Display_Atend_Message *)



(*
*  This routine prompts the operator for employee ID and termination date.
*)
PROCEDURE Get_Employee_Info;

(*
*  Variables for use in constructing the date-time string for conversion
*  The user inputs a text string value.  The program uses system routines
*  to convert the text string value to the binary format stored in the database.
*
*  NOTE: SQL can perform the date type conversion, eliminating the need for a
*  call to $BINTIM in the program.  To have SQL handle the conversion, the
*  program must pass a string value in the all-digit format YYYYNNDDHHMMSSGG.
*  This format is different than the standard OpenVMS text format for dates and
*  should not be used for user input directly (the various day and month
*  reversal errors that can be made when the input format requires two-digit
*  strings for both day and month cannot all be detected).
*)

LABEL	Employee_Exists_Exit;
VAR
    Status_Code : CHAR;
    End_Date : PACKED ARRAY[1..8] OF CHAR;
    End_Date_Time : PACKED ARRAY[1..16] OF CHAR;

BEGIN
    Employee_Exists := FALSE;
    FOR I := 1 TO 24 DO WRITELN;
    WRITELN('Please enter the employee id number of the employee who is '
	    + 'now inactive');
    WRITELN;
    WRITE('Employee ID: ');
    READLN(Employee_Id);
    WRITELN;
    WRITELN;
    WRITELN('Please enter the job termination date.');
    WRITELN('Use format yyyymmdd (for example 19861021 as October 12,1986).');
    WRITELN;
    WRITE('Date: ');
    READLN(End_Date);
    WRITELN;

(*
*  This program does not evaluate the date value input by the user and
*  reprompt if necessary.  Such processing could be included at this point.
*)
    End_Date_Time := End_Date + '00000000';

(*
*  Check for the existance of an employee ID in the database.
*)
(* OPEN a cursor (declared in the module file) to contain the EMPLOYEES row
*  with the ID entered by the user.  If the FETCH retrieves a row (the cursor
*  is not empty), the ID exists in the database.  The program assumes that the
*  retrieved row is the one that the user intends to change.
*
*  The database is attached when the first transaction is started.  If the
*  database attachment fails or a transaction cannot be started, the ROLLBACK
*  executed in Lock_Error_Check will also fail.  The message vector will then
*  reflect the values associated with the failure of the ROLLBACK statement and
*  not the SET TRASNACTION statement.  Although the program could have displayed
*  messages and accepted user input to continue BEFORE executing the ROLLBACK
*  statement, doing so would cause the transaction to span terminal I/O.
*
*  Other programs may require more complex code which might move the messages
*  retrieved for the SET TRANSACTION statement to a buffer that is not affected
*  by execution of the ROLLBACK, monitor execution of the ROLLBACK statement,
*  and, if the ROLLBACK fails, display the contents of that buffer to the user
*  as well.
* 
*  Note that a transaction is not started until after the user is prompted for
*  all input and any program conversions have been done.  This ensures that time
*  for terminal I/O is not included in the time it takes to complete the
*  transaction.  Given the task being performed here (changing data to show an
*  employee no longer works for the company), it is unlikely that other users
*  need access to the rows locked by transactions that this program starts.
*  It is still a good rule, however, to avoid transactions that span terminal
*  I/O operations.
*)
    Set_Transaction(Sql_Return_Status);
    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Lock_Error_Check;
	    GOTO Employee_Exists_Exit;
	END;
	    
(* 
*  Handle errors that may occur when the cursor is OPEN.  Lock_Error_Check
*  executes a ROLLBACK in the case of every fatal error.
*)
    Open_Cursor(Sql_Return_Status,Employee_Id);
    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Lock_Error_Check;
	    GOTO Employee_Exists_Exit;
	END;

(* 
*  FETCH a row from the opened cursor
*  Handle the not found condition and then any unexpected errors that may
*  occur when a row is FETCHed from a cursor.
*)
    Fetch_Employees(Sql_Return_Status,Employee_Id,Status_Code);
     IF Sql_Return_Status = Id_Not_Found THEN
	BEGIN
	    Rollback_Transaction(Sql_Return_Status);
	    Display_Atend_Message;
	    GOTO Employee_Exists_Exit;
	END;

    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Lock_Error_Check;
	    GOTO Employee_Exists_Exit;
	END;

    Get_Date(Sql_Return_Status,Job_End,END_DATE_TIME);

    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Rollback_Transaction(Sql_Return_Status);
	    FOR I := 1 TO 24 DO WRITELN;
	    WRITELN('The date entered was entered wrong.');
	    GOTO Employee_Exists_Exit;
	END;

(*
*  Success to this point means that a row was returned by the FETCH.  This
*  program assumes that it is the employee to be updated and checks no further.
*  Simply return with the employee_exists true.
*)
    Employee_Exists := TRUE;

Employee_Exists_Exit:
END;	(* Employee Exists *)



(*
*  Update_Database modifies the EMPLOYEES, JOB_HISTORY, and SALARY_HISTORY rows,
*  and then, if no errors are encountered, commits the changes.  Note that this
*  program does not check to make sure that there are current rows for an
*  employee in the JOB_HISTORY and SALARY_HISTORY tables or that STATUS_CODE in
*  the EMPLOYEES table is not already 0.  If there are no current rows in 
*  JOB_HISTORY or SALARY_HISTORY (rows where JOB_END or SALARY_END are null), no
*  rows are updated in those tables.  If STATUS_CODE is already 0, it is set to 
*  0 again.  Depending on how a database is set up and maintained, programs may
*  need to perform more checks than are illustrated in this sample.
*)
PROCEDURE Update_Database;

LABEL	Update_Database_Exit;

BEGIN
(* 
*  UPDATE the EMPLOYEES table
*)
    Update_Employees(Sql_Return_Status);
    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Lock_Error_Check;
	    GOTO Update_Database_Exit;
	END;

(* 
*  UPDATE the JOB_HISTORY table
*)
    Update_Jobhist(Sql_Return_Status,Employee_Id,Job_End);
    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Lock_Error_Check;
	    GOTO Update_Database_Exit;
	END;

(* 
*  UPDATE the SALARY_HISTORY table
*)
    Update_Salhist(Sql_Return_Status,Employee_Id,Job_End);
    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Lock_Error_Check;
	    GOTO Update_Database_Exit;
	END;

(* 
*  COMMIT the TRANSACTION
*)
    Commit_Transaction(Sql_Return_Status);
    IF Sql_Return_Status < 0 THEN
	BEGIN
	    Lock_Error_Check;
	    GOTO Update_Database_Exit;
	END;
    
Update_Database_Exit:
END;	(* Update_Database *)



(*
*  Main program
*
*  The main program will loop until the operator requests to exit.
*  The main option dialog returns an option code that controls the loop.
*  If an update is requested, the employee id and termination date for the
*  employee is requested.  The database is checked for the employee id and
*  is the employee's status and termination date are updated if it is found.
*)
BEGIN

WHILE (Main_Option_Input <> Exit_Code) DO
    BEGIN
	Get_Employee_Info;
	IF Employee_Exists THEN
	    Update_Database;
    END; (* of while *)

END.  (* Sql_Terminate *)