HP 3000 Manuals HP 3000 Manuals
ORDERS Database Model Program (contd) Closing the database (contd) FORTRAN 77 Portions of the model program presented at the beginning of this chapter are now shown here in FORTRAN 77. The examples perform specific tasks to illustrate the use of TurboIMAGE/XL intrinsics. Data items are defined at the beginning of the sample program. Explicit declaration of intrinsics is not required. Other global variables in this program are placed in a COMMON file.
NOTE Because the Schema Processor, DBSCHEMA, upshifts alphabetic characters, programs must specify data set and data item names in all uppercase characters. Take note of this if FORTRAN 77 does not require that you use uppercase characters.
For information on TurboIMAGE/XL data item lengths and type designators, refer to chapter 3. Tables 3-2 and 3-3 show the TurboIMAGE/XL type designators, sub-item lengths, and data types typically used to process them in Pascal.
NOTE All parameters must be on halfword boundaries.
Because FORTRAN 77 requires that the parameters be on halfword boundaries, they must be integer arrays equivalenced to character strings if necessary. Defining Data Types, Variables, and Intrinsics The following declarations are placed in a FORTRAN 77 COMMON file. This file enables different subroutines to import all necessary declarations. In this program, the COMMON file is called comon1 and is included with the directive $Include 'comon1'. C**** TurboIMAGE/XL's Global Declaration C**** Set up for the Database name parameter. Integer*2 DBname(10) Character BaseName*16 Equivalence(DBname(1),BaseName) Common /Database_Name_Type / DBname C**** Set up for the Password parameter. Character Pass_Word*10 Integer*2 Password(5) Equivalence (Password(1),Pass_Word) Common /Database_password_type/ password C**** Set up for the Mode parameter. Integer In,Out,Not_Used_Parm Integer*2 Mode Integer*2 Mode1_SMA, Mode5_Unconditional, Mode1_Chained_Read Integer*2 Mode5_Forward, Mode1_Unlock C**** Set up for the Status parameter. Integer*2 Status(10) Integer*2 Condition Integer*2 Length Integer*4 Record_Number Integer*4 Chain_Count Integer*4 Back_Pointer Integer*4 Forward_Pointer Equivalence(Status(1),Condition),(Status(2),Length) Equivalence(Status(3),Record_Number),(Status(5),Chain_Count) Equivalence(Status(7),Back_Pointer),(Status(9),Forward_Pointer) Common /Database_Status_Type/ Status C**** Set up for the Lock_Descriptor_Array of the Sales data set. Integer*2 Lock_Descriptor_Array(22) Integer*2 Length_Of_Descriptor, Num_Of_Elements Character Data_Set_Of_Descriptor*16 Character Data_Item_Of_Descriptor*16 Character Relative_Operator*2 Character Value_For_Data_Item*6 Equivalence (Lock_Descriptor_Array(1), Num_Of_Elements) Equivalence (Lock_Descriptor_Array(2), Length_Of_Descriptor) Equivalence (Lock_Descriptor_Array(3), Data_Set_Of_Descriptor) Equivalence (Lock_Descriptor_Array(11),Data_Item_Of_Descriptor) Equivalence (Lock_Descriptor_Array(19),Relative_Operator) Equivalence (Lock_Descriptor_Array(20),Value_For_Data_Item) C**** Set up for the Sales_Buffer of the Sales data set. Integer*2 Sales_Buffer(19) Integer*4 Account_Number Character Stock_Number*8 Integer*2 Quantity Integer*4 Price Integer*4 Tax Integer*4 Total Character Purch_Date*6 Character Deliv_Date*6 Equivalence (Sales_Buffer(1), Account_Number) Equivalence (Sales_Buffer(3), Stock_Number) Equivalence (Sales_Buffer(7), Quantity) Equivalence (Sales_Buffer(8), Price) Equivalence (Sales_Buffer(10),Tax) Equivalence (Sales_Buffer(12),Total) Equivalence (Sales_Buffer(14),Purch_Date) Equivalence (Sales_Buffer(17),Deliv_Date) Main Body of Program In the following portion of the program, the $hp3000_16$ compiler directive allows the FORTRAN 77 compiler to change the data alignment from a four-byte limit to a two-byte limit. For example, the non-alignment caused by the Quantity field in the Sales data set can be resolved using this directive. $hp3000_16$ Program Fortran_For_TurboIMAGEXL C C This area will contain the main line for the C FORTRAN 77 example. C Obtaining Error Messages and Explanations The following procedure implements the Get_Error_And_Explain routine of the sample program. In this procedure, DBEXPLAIN and DBERROR are called using FORTRAN 77. DBEXPLAIN interprets the contents of the status parameter and prints a message on $STDLIST. DBERROR returns a message in ERROR_Buffer, explaining the condition code returned by TurboIMAGE/XL. At the end of the procedure, users can choose to abort or continue the execution of this program. Note that aborting a process from within a transaction would result in an incomplete transaction. It is good programming practice to end your transaction, release your locks, and close any open database(s) before aborting your process. C*********************************************************************** Subroutine Get_Error_And_Explain C Access : Mode 1 - Shared Modified Access C C C Called By : Open_The_Database C Get_Sales_For_Date C Get_A_Customer_Record C Get_A_Product_Record C List_All_Customers C Add_A_Product C Update_A_Customer C Delete_A_Product C Rewind_Customer_Set C Get_Data_Item_Info C Close_The_Database C C C Calls : DBERROR C DBEXPLAIN C $list Off $Include 'comon1' $list On C Prepare the error buffer for calls to DBERROR C Character Error_Buffer_Text*80 Integer*2 Error_Buffer(40) Equivalence (Error_Buffer(1),Error_Buffer_Text) Integer*4 Error_Length Integer*2 Answer Parameter (In=5,Out=6) Call DBERROR (Status,Error_Buffer,Error_Length) Write(Out,*)'--------------------------------------' Write(Out,10)Error_Buffer_Text 10 Format(A60) Write(Out,*)'--------------------------------------------' Call DBEXPLAIN (Status) Answer=0 Write(Out,*)'---Enter, <1> to ABORT..., <2> to Continue >' Read (In,20) Answer 20 Format(I2) If (Answer.NE.1) Then Write(Out,*)' Continuing......' Else Stop Endif Return End Opening the Database This procedure implements the Open_The_Database procedure of the sample program. All required values, such as, the password, are provided by the routine. Note that the password DO-ALL is followed by a semicolon because it is less that eight characters long; a blank can be substituted for the semicolon. Open_The_Database uses open mode 1, which is the shared modify access mode. Error trapping is done by referring all non-zero conditions to the Get_Error_And_Explain procedure. C***************************************************************** Subroutine Open_The_Database C C ACCESS : Mode 1 - Shared Modify Access (SMA) with locking required C C CALLED BY : Main Line C C CALLS : DBOPEN in mode 1 (SMA) C Get_Error_And_Explain C $List Off $Include 'comon1' $List On C**** Prepare the Base parameter of the DBOPEN. C Mode1_SMA = 1 BaseName=' ORDERS; ' Pass_Word='DO-ALL;' Call DBOPEN (DBname,Password,Mode1_SMA,Status) If (Condition.NE.0) Then Call Get_Error_And_Explain EndIf Return End Retrieving All the Records on a Chain (with Item Level Locking) This procedure implements the Get_Sales_For_Date routine of the sample program. Chained access is achieved using a call to DBFIND. The search item used for this call is Purch-Date. An item level lock is obtained on the value of the search item before the DBFIND call. After that, individual chain items are retrieved, until the end of chain is encountered. This is done using multiple calls to the DBGET procedure. This routine traps two exceptional conditions: 1. Status condition from the DBFIND call, indicating that the chain head cannot be located. 2. Status 15 from DBGET, indicating the end of the chain. The status interpretaion routine permits you to either abort or continue with the execution after viewing all error messages. C*************************************************************** Subroutine Get_Sales_For_Date C ACCESS : Mode 1 - Shared Modify Access C C CALLED BY : Main Line C C CALLS : DBLOCK in mode 5 (unconditional item level locking) C DBFIND in mode 1 (chained access) C DBGET in mode 5 (forward chain read) C DBUNLOCK in mode 1 (unlock) C***** Get_Error_And_Explain (chained access) $list off $include 'comon1' $list on C** The Input/Output indicator values Parameter (In=5,Out=6) Integer*4 End_Of_Chain,No_Chain_Head C** Set up for the data set parameter. Character Data_Set_Name_Is*16 Integer*2 Sales_Detail(8) Equivalence (Sales_Detail(1),Data_Set_Name_Is) C** Set up for the search item parameter. Character Search_Item_Name_Is*16 Integer*2 Search_Item_Name(8) Equivalence (Search_Item_Name(1),Search_Item_Name_Is) C** Set up for the search value/argument parameter. Character Search_Item_Value_Is*6 Integer*2 Search_Item_Value(3) Equivalence (Search_Item_Value(1),Search_Item_Value_Is) Parameter (End_Of_Chain=15,No_Chain_Head=17) C** Set up for the predicate buffer used in item level locking. Num_Of_Elements = 1 Length_Of_Descriptor = 21 Data_Set_Of_Descriptor ='SALES;' Data_Item_Of_Descriptor='PURCH-DATE;' Relative_Operator =' =' C** Accept the search value. Print*,' Enter The Date of Purchase as (YYMMDD) >>> ' Read (5,10) Search_Item_Value_Is 10 Format(A6) C** Request item level locks on all items identified by the search C** value. A mode value of 5 indicates an item level lock request. Mode5_Unconditional =5 Value_For_Data_Item = Search_Item_Value_Is Call DBLOCK (DBname,Lock_Descriptor_Array,Mode5_Unconditional, & Status) If (Condition.NE.0) then Call Get_Error_And_Explain EndIf C** Locate all entries identified by the search value. Data_Set_Name_Is = 'SALES;' Mode1_Chained_Read = 1 Search_Item_Name_Is = 'PURCH-DATE;' Call DBFIND (DBname,Sales_Detail,Mode1_Chained_Read,Status, & Search_Item_Name,Search_Item_Value) If (Condition.NE.0) Then If (Condition.EQ.No_Chain_Head) Then Print*,'_____________________________________________' Print*,'| |' Print*,'| No Such Entry In the Sales Data Set |' Print*,'| |' Print*,'|___________________________________________|' Print*,'Hit Enter to Continue .................... ' Read(5,*) Else Call Get_Error_And_Explain EndIf Else Write(6,20) Write(6,30) 20 Format (' Acct-Number Stock-Number Qty Price Tax Total ', &'Purch-Date Deliv-Date ') 30 Format (' --------------------------------------------------- ', &'------------------------ ') Mode5_Forward = 5 List = '@;' Do While (Condition.NE.End_Of_Chain) Call DBGET (DBname,Sales_Detail,Mode5_Forward, Status, & List, Sales_Buffer, Not_Used_Parm) If (Condition.NE.0) Then If (Condition.EQ.End_Of_Chain) Then Print *,'-->End Of Chain, Hit Enter to Continue' Read (5,*) Else Call Get_Error_And_Explain EndIf Else Print* Print*,Account_Number,' ', & Stock_Number,' ', & Quantity,' ',Price,' ',Tax,' ',Total,' ', & Purch_Date,' ',Deliv_Date EndIf End Do EndIf Mode1_Unlock =1 Call DBUNLOCK (DBname,Sales_Detail,Mode1_Unlock,Status) If (Condition.NE.0) Then Call Get_Error_And_Explain EndIf Return End Pascal Portions of the model program presented at the beginning of this chapter are now shown here in Pascal. The examples perform specific tasks to illustrate the use of TurboIMAGE/XL intrinsics. Data items are defined at the beginning of the sample program. TurboIMAGE/XL intrinsics must be declared for Pascal as external procedures. The procedure name is followed by the word "Intrinsic." Type declarations declare names for data structure forms that will be used in allocating variables. Variable declarations allocate the variables of the program. Variables are defined with precise types or forms. Pascal string literals are delimited with single quotes (' '). Field and record names are separated with a dot (.), when referenced (for example, "base_name.baseid").
NOTE Because the Schema Processor, DBSCHEMA, upshifts alphabetic characters, programs must specify data set and data item names in all uppercase characters. Take note of this because Pascal does not require that you use uppercase characters.
For information on TurboIMAGE/XL data item lengths and type designators, refer to chapter 3. Tables 3-2 and 3-3 show the TurboIMAGE/XL type designators, sub-item lengths, and data types typically used to process them in Pascal.
NOTE All parameters must be on halfword boundaries and cannot be odd-byte aligned.
Defining Data Types, Variables, and Intrinsics The following is part of the Pascal example program; it defines type declarations, variable declarations, and TurboIMAGE/XL intrinsics. $Standard_Level 'HP_MODCAL'$ $hp3000_16$ Program Pascal_For_TurboIMAGEXL (Input,Output); Label 100; (* Define all your TurboIMAGE/XL constants. *) Const End_Of_Chain =15; (* For DBGET Mode 5 *) End_Of_Data_Set =11; (* For DBGET Mode 2 *) No_Chain_Head =17; (* For DBFIND *) No_Such_Entry =17; (* For DBGET Mode 7 *) Entry_Has_No_Data =17; (* For DBGET Mode 4 *) (* Define all your TurboIMAGE/XL record structures. *) Type (* for the base parameter *) Database_Name_Type = Packed Record BaseId : Packed Array [1..2] of Char; BaseName : Packed Array [1..16] of Char; End; (* for the password parameter *) Database_Password_Type = Packed Array [1..10] of Char; (* for the status parameter *) Database_Status_Type = Packed Record Condition : ShortInt; Length : ShortInt; Record_Number : Integer; Chain_Count : Integer; Back_Pointer : Integer; Forward_Pointer : Integer; End; (* for the data set name parameter *) Data_Set_Name_Type = Packed Array [1..16] of Char; (* for data item names *) Data_Item_Name_Type = Packed Array [1..16] of Char; (* for the list parameter *) Data_Item_List_Type = Packed Array [1..80] of Char; (* for key items in manual masters *) Key_Item_Type = Packed Array [1..40] of Char; (* for the Sales data set of Orders DB *) Sales_Data_Set_Type = Packed Record Account_Number: Integer; Stock_Number : Packed Array [1..8] of Char; Quantity : ShortInt; Price : Integer; Tax : Integer; Total : Integer; Purch_Date : Packed Array [1..6]of Char; Deliv_Date : Packed Array [1..6]of Char; End; (* for item level locks in the Sales set *) Lock_Descriptor_Sales_Type = Packed Record Length_Of_Descriptor : ShortInt; Data_Set_Of_Descriptor : Data_Set_Name_Type; Data_Item_Of_Descriptor : Data_Item_Name_Type; Relative_Operator : Packed Array [1..2]Of Char; Value_For_Data_Item : Packed Array [1..6]Of Char; End; (* for the lock buffer for the Sales set *) Lock_Descriptor_Sales_Array_Type = Packed Record Num_Of_Elements : ShortInt; Lock_Descriptor_Sales : Lock_Descriptor_Sales_Type; End; Var (* Define all your global variables. *) DBname : Database_Name_Type; Password : Database_Password_Type; Status : Database_Status_Type; Option : ShortInt; Mode : ShortInt; List : Data_Item_List_Type; (* Define all TurboIMAGE/XL procedure calls that *) (* will be used in your application program. *) Procedure DBBEGIN ; Intrinsic; Procedure DBEND ; Intrinsic; Procedure DBOPEN ; Intrinsic; Procedure DBCLOSE ; Intrinsic; Procedure DBGET ; Intrinsic; Procedure DBPUT ; Intrinsic; Procedure DBFIND ; Intrinsic; Procedure DBEXPLAIN ; Intrinsic; Procedure DBERROR ; Intrinsic; Procedure DBDELETE ; Intrinsic; Procedure DBUPDATE ; Intrinsic; Procedure DBLOCK ; Intrinsic; Procedure DBUNLOCK ; Intrinsic; Procedure DBINFO ; Intrinsic; Obtaining Error Messages and Explanations The following procedure implements the Get_Error_And_Explain routine of the sample program. In this procedure, DBEXPLAIN and DBERROR are called using Pascal. DBEXPLAIN interprets the contents of the Status parameter and prints a message on $STDLIST. DBERROR returns a message in Error_Buffer, explaining the condition code returned by TurboIMAGE/XL. At the end of the procedure, users can choose to abort or continue the execution of this program. Note that aborting a process from within a transaction would result in an incomplete transaction. It is good programming practice to end your transaction, release your locks, and close any open database(s) before aborting your process. $Page$ Procedure Get_Error_And_Explain; (* Access : Mode 1 - Shared Modified Access The Orders database was opened in mode 1 Called by: Open_The_Database Get_Sales_For_Date Get_A_Customer_Record Get_A_Product_Record List_All_Customers Add_A_Product Update_A_Customer Delete_A_Product Rewind_Customer_Set Get_Data_Item_Info Close_The_Database Calls : DBERROR DBEXPLAIN *) Var Error_Buffer : Packed Array [1..80] of Char; Error_Length : Integer; Answer : ShortInt; Begin DBERROR (Status,Error_Buffer,Error_Length); Writeln('-------------------------------------------'); Writeln(Error_Buffer); Writeln('-------------------------------------------'); Writeln; DBEXPLAIN (Status); Answer:=0; Prompt( '---Enter, <1> to ABORT..., <2> to Continue >'); Readln(Answer); If Answer <> 1 Then Writeln(' Continuing .........') Else Halt; End; Opening the Database This procedure implements the Open_The_Database procedure of the sample program. All required values, such as the password, are provided by the routine. Note that the password DO-ALL is followed by a semicolon because it is less than eight characters long; a blank can be substituted for the semicolon. Open_The_Database uses open mode 1, which is the shared modify access mode. Error trapping is done by referring all non-zero conditions to the Get_Error_And_Explain procedure. $Page$ Procedure Open_The_Database; (* Access : Mode 1 - Shared Modify Access (SMA) with locking required Called By: Main Line Calls : DBOPEN in mode 1 (SMA) Get_Error_And_Explain *) Begin Mode1_SMA : Integer; DBname.BaseID :=' '; DBname.BaseName :='ORDERS; '; Password :='DO-ALL;'; Mode1_SMA :=1; DBOPEN (DBname,Password,Mode1_SMA,Status); If Status.Condition <> 0 Then Get_Error_And_Explain; End; Retrieving All the Records on a Chain (with Item Level Locking) This procedure implements the Get_Sales_For_Date routine of the sample program. Chained access is achieved using a call to DBFIND. The search item used for this call is Purch-Date. An item level lock is obtained on the value of the search item before the DBFIND call. After that, individual chain items are retrieved, until the end of chain is encountered. This is done using multiple calls to the DBGET procedure. The routine traps two exceptional conditions: 1. Status condition 17 from the DBFIND call, indicating that the chain head cannot be located. 2. Status 15 from the DBGET call, indicating the end of chain. The status interpretation routine permits you to either abort or continue with the execution of the program after viewing all error messages. $Page$ Procedure Get_Sales_For_Date; (* Access : Mode 1 - Shared Modify Access The Orders database was opened in mode 1. Called By: Main Line Calls : DBLOCK in mode 5 (unconditional item level locking) DBFIND in mode 1 (chained access) DBGET in mode 5 (forward chained read) DBUNLOCK in mode 1 (unlock) Get_Error_And_Explain *) Var Lock_Descriptor_Array : Lock_Descriptor_Sales_Array_Type; Sales_Detail : Data_Set_Name_Type; Search_Item_Name : Data_Item_Name_Type; Search_Item_Value : Packed Array [1..6]of Char; Sales_Buffer : Sales_Data_Set_Type; Not_Used_Parm : Shortint; Mode1_Chained_Read : Shortint; Mode5_Unconditional : Shortint; Mode5_Forward : Shortint; Mode1_Unlock : Shortint; Begin (* Prepare the lock descriptor buffer for obtaining item level *) (* locks on the Sales data set. *) With Lock_Descriptor_Array Do Begin Num_Of_Elements := 1; With Lock_Descriptor_Sales Do Begin Length_Of_Descriptor := 21; Data_Set_Of_Descriptor :='SALES;'; Data_Item_Of_Descriptor :='PURCH-DATE;'; Relative_Operator :=' ='; End; End; Prompt (' Enter The Date of Purchase as (YYMMDD) >>> '); Readln (Search_Item_Value); Mode5_Unconditional :=5; (* Request item level locks. *) (* Append the user's input to the lock descriptor buffer. *) Lock_Descriptor_Array. Lock_Descriptor_Sales.Value_For_Data_Item :=Search_Item_Value; (* Place item level locks on all entries identified by *) (* the value in the Search_Item_Value. *) DBLOCK (DBname,Lock_Descriptor_Array,Mode5_Unconditional,Status); If Status.Condition <> 0 then Get_Error_And_Explain; Sales_Detail :='SALES;'; Search_Item_Name :='PURCH-DATE;'; Mode1_Chained_Read :=1; (* Locate the chain identified by the value in the *) (* Search_Item_Value. *) DBFIND (DBname,Sales_Detail,Mode1_Chained_Read,Status, Search_Item_Name,Search_Item_Value); If Status.Condition <>0 Then Begin If Status.Condition = No_Chain_Head Then Begin Writeln('***************************************'); Writeln('* No Such Entry in the Sales Dataset *'); Writeln('* Please Try Again. *'); Writeln('***************************************'); Prompt ('Hit Enter To Continue ---------------->'); Readln; End Else Get_Error_And_Explain; End Else Begin Write('Acct-Number'); Write('Stock-Number':14); Write('Qty':6); Write('Price':7 ); Write('Tax':5); Write('Total':8); Write('Purch-Date':12); Write('Delive-Date':14); Write('---------------------------------------------------); Write('---------------------------'); Writeln; (* Start retrieving all records in the current chain. *) Mode5_Forward :=5; List :='@;'; While Status.Condition <> End_Of_Chain Do Begin (* Retrieve the contents of the entry which is at the *) (* current record pointer. *) DBGET (DBname,Sales_Detail,Mode5_Forward,Status,List,Sales_Buffer, Not_Used_Parm); If Status.Condition= 0 Then Begin With Sales_Buffer Do Begin Writeln; Write(Account_Number:10); Write(Stock_Number:15); Write(Quantity:6); Write(Price:7 ); Write(Tax:5 ); Write(Total:7); Write(Purch_Date:12); Write(Deliv_Date:12); End; End (* Check the status buffer for any condition *) Else (* codes not equal to zero. *) Begin If Status.Condition= End_Of_Chain Then Begin Writeln; Writeln; Writeln; Prompt ('----> End Of Chain, Hit Enter to Continue'); Readln; End Else Get_Error_And_Explain; End; End; End; (* Release all locks acquired at the beginning of the process. *) Mode1_Unlock :=1; DBUNLOCK (DBname,Sales_Detail,Mode1_Unlock,Status); If Status.Condition<>0 Then Get_Error_And_Explain End; $Page$