HP 3000 Manuals HP 3000 Manuals
ORDERS Database Model Program (Continued)
FORTRAN 77 (Continued)
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 interpretation 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;