6 Example Operations

Eloquence DBMS Programming Examples

Once a database has been defined using the schema program and created using dbcreate, data can be written to and read from the database using the manipulation commands (page 59 ). This section gives examples of each of the database manipulation statements. All programs work with the Sales Analysis Database (SAD) discussed in the previous section.

Example Program 1

One of the simplest reports that can be produced is a list of a data set's contents. A sample listing of the contents of the CUSTOMER data set is shown next, as produced by example program 1.

OUTSTANDING ORDERS LIST
ORDER NUMBER CUSTOMER NAME PRICE
100SMITH THOMAS A.175.50
101NONAME, JOSEPH77.50
102JOHNSON, SAM162.50
103HERNANDES, JOSE109.75
104HOUSEMAN, SEAN133.00
105SONO, JOMO A.135.00
106HEINZ HEINING175.00
107DALLING, JIMMY150.00
108ARAUJA, LUCIANO80.00
109BEKKER,BART125.00
110GISSING,MALCOMB45.00
  ======
 TOTAL ORDERS1368.25

For the programmer who has not used Eloquence DBMS, there are several small, but important, details which should be noted. In line 1080, B$ is defined as the database name. Two blanks must precede the name. The DBOPEN statement (line 1100) fills these blanks with a database id number (two ASCII digits from 00 through 09). This id number is used in subsequent DBML statements to identify the database, rather than the database name.

Note that the DBOPEN statement opens the database for exclusive access. This means that if another user attempts to open the database an error occurs when DBOPEN is executed. This error takes the form of a non-zero value in the first element of the status array S(*). S(*) must be of type integer and must contain at least ten elements, in this case S(0) through S(9).

1000 !   EXAMPLE PROGRAM 1
1010 !
1020 !   OUTSTANDING ORDERS REPORT (NOT INCLUDING ALL DETAIL)
1030 !
1040     INTEGER S(9)
1050     DIM B$[12],P$[10],Buf$[170]
1060     DIM Desc$[30],order_no$[10],Name$[30]
1070     DISP "Cr/H Cl/S";        ! CLEAR SCREEN
1080     B$="  SAD,SALES"
1090     P$="MANAGER"
1100     DBOPEN (B$,P$,3,S(*))   ! OPEN FOR EXCLUSIVE ACCESS
1110     IF S(0) THEN Dberr
1120  !
1130  !  INITIALIZE VARIABLES & PRINT REPORT HEADER
1140  !
1150  Rep: Total=0
1160     Eof=11
1170     PRINT TAB(20);"OUTSTANDING ORDERS LIST";LIN(1)
1180     PRINT "ORDER NUMBER     CUSTOMER NAME";SPA(14);"PRICE";
                    LIN(1);RPT$("-",48);LIN(1)
1190  !
1200  !  PRODUCE THE REPORT
1210  !
1220  START report:DBGET (B$,"CUSTOMER",2,S(*),"@",Buf$,0)
1230     IF S(0)=Eof THEN End_report
1240     IF S(0) THEN Dberr
1250     UNPACK USING Pf2;Buf$
1260  Pf2:PACKFMT Order_no$,Name$,60X,16X,6X,12X,8X,2X,2X,6X,2X,
          Price
1270     PRINT USING Itm_image;Order_no$,Name$,Price
1280  Itm_image: IMAGE 16A,22A,2X,5D.DD
1290  !
1300  !  ACCUMULATE TOTAL
1310  !
1320     Total=Total+Price
1330     GOTO Start_report
1340  !
1350  !  PRINT FINAL TOTALS
1360  !
1370  End_report:PRINT USING Tot_image;Total
1380     END
1390  Tot_image:IMAGE 39X,9("=") / 3X,"TOTAL ORDERS",24X,6D.DD /
1400  !
1410  !  DATABASE ERROR HANDLER
1420  !
1430  Dberr:DISP LIN(1);"UNEXPECTED DATABASE ERROR ";
            VAL$(S(0));" IN LINE";S(6)
1440     END
In line 1070 of the program on the previous page, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively.

The status array should be checked for an abnormal condition (non-zero first element) after each DBML operation. If an abnormal condition is detected in this program, control is transferred to the line labeled Dberr, which displays the error code in the status array and the line number where the error occurred.

The process of reading all orders is accomplished by a loop containing a serial-access DBGET (see line 1220). This line reads the next non-empty record from the CUSTOMER set and puts the record into the string Buf$.

The pertinent items from this buffer are extracted via the UNPACK USING statement and then printed. Note the use of Xs to skip unused fields in the PACKFMT. For clarity, each X field corresponds to a field in the database. The whole group could be replaced, however, by 114X. Before reading the next record, the price of the current order is added into the total price of all orders read so far.

When the orders in the CUSTOMER set are exhausted, the first element of the status array, S(0), indicates when an end-of-file has been reached. Line 1230 detects this and branches to print the total of all order prices.

Example Program 2

Example program 2 prints a list of all orders grouped by product. This is accomplished by serially reading each entry in the PRODUCT set (see line 1220). Then, for each product, a listing of the record contents with the same product number in the CUSTOMER detail data set is produced.

It is not necessary to scan the entire CUSTOMER section to find entries with the correct product number. The chain between the CUSTOMER set and the PRODUCT set with PRODUCT-NO as the search field allows direct access to those entries in the CUSTOMER set with a particular product number. To access the entries on the chain, a DBFIND is first executed (line 1340). Status array element S(5) returns the number of entries in the chain. A FOR-NEXT loop going from 1 to S(5) with a chained mode DBGET (line 1370) extracts the information for each order with the desired product number.

The procedure reads the chain in a "forward" direction. It is possible to read the chain backwards by using a direct mode DBGET and chain pointers which are returned in the status array by both DBFIND and DBGET. It is also possible to use DBGET mode 6 (chained backward). To change example program 2 to do a backward chain read, replace line 1370 with the following:

1370 DBGET (B$,"CUSTOMER",4,S(*),"@",Buf$,S(7))
or

1370 DBGET (B$,"CUSTOMER",6,S(*),"@",Buf$,(0))
Example program 2 also solves one of the problems of program 1. By opening the database in mode 8 (read-only mode) instead of mode 3 (exclusive access), other users can also open the database in mode 8 and do concurrent reads. Opening in mode 8, however, fails if another user has the database opened in either mode 3 or mode 1. As long as the database is opened by one user in mode 8, no one can open it in a mode which permits modifications of the database.

                     OUTSTANDING ORDERS LIST

PRODUCT            ORDER NUMBER        CUSTOMER NAME         PRICE

------------------------------------------------------------------
50   (Tricycle)
                   110                 Gissing, Malcomb      45.00
                                                           =========
  TOTAL ORDERS FOR 50                                        45.00

1000 (10-Speed Bicycle)
                   102                  Johnson, Sam        162.50
                   106                  Heining, Heinz      175.00
                   107                  Dalling, Jimmy      150.00
                                                           =========
  TOTAL ORDERS FOR 1000                                     487.50

100  (Standard Bicycle)
                   101                  Noname, Joseph       77.50
                   103                  Hernandes, Jose     109.75
                   108                  Arauja, Luciano A.   80.00
                                                           =========
  TOTAL ORDERS FOR 100                                      267.25

300  (3-Speed Bicycle)
                   104                  Houseman, Sam       133.00
                                                           =========
  TOTAL ORDERS FOR 300                                      133.00

500  (5-Speed Bicycle)
                   100                  Smith, Thomas A.    175.50
                   105                  Sono, Jomo A.       135.00
                   109                  Bekker, Bart        125.00
                                                           =========
  TOTAL ORDERS FOR 500                                      435.50

                                        TOTAL ORDERS      $1368.25
                                                         ===========
1000  !   EXAMPLE PROGRAM 2
1010  !
1020  !   OUTSTANDING ORDERS REPORT (NOT INCLUDING ALL DETAIL)
1030  !
1040     INTEGER S(9), Prod_no
1050     DIM B$[12],P$[10],Buf$[170]
1060     DIM Desc$[30],Order_no$[10],Name$[30]
1070     DISP "Cr/H Cl/S";        ! CLEAR SCREEN
1080     B$="  SAD,SALES"
1090     P$="MANAGER"
1100     DBOPEN (B$,P$,8,S(*))     ! OPEN FOR READ-ONLY ACCESS
1110     IF S(0) THEN Dberr
1120  !
1130  !   INITIALIZE VARIABLES & PRINT REPORT HEADER
1140  !
1150  Rep:Total=Master_total=0
1160     Eof=11
1170     PRINT TAB(20);"OUTSTANDING ORDERS LIST";LIN(1)
1180     PRINT "PRODUCT       ORDER NUMBER      'CUSTOMER NAME";
         SPA(14);"PRICE";LIN(1);RPT$("-",63);LIN(1)
1190  !
1200  !   PRODUCE THE REPORT
1210  !
1220  Start_report:DBGET (B$,"PRODUCT",2,S(*),"@",Buf$,0)
1230     IF S(0)=Eof THEN End_report
1240     IF S(0) THEN Dberr
1250     UNPACK USING Pf;Buf$
1260  Pf: PACKFMT Prod_no,Desc$
1270  !
1280  !   PRINT HEADER FOR PRODUCT
1290  !
1300     PRINT VAL$(Prod_no);" (";TRIM$(Desc$);")"
1310  !
1320  !   PRINT ORDERS
1330  !
1340     DBFIND (B$,"CUSTOMER",1,S(*),"PROD_NO",Prod_no)
1350     IF S(0) THEN Dberr
1360     FOR I=1 TO S(5)
1370       DBGET (B$,"CUSTOMER",5,S(*),"@"Buf$,0)
1380       IF S(0) THEN Dberr
1390       UNPACK USING Pf2;Buf$
1400  Pf2: PACKFMT Order no$,Name$,60X,16X,6X,12X,8X,2X,2X,6X,
              2X,Price
1410       PRINT TAB(16);
1420       PRINT USING Itm_image;Order_no$,Name$,Price
1430  Itm_image:IMAGE 16A,22A,2X,5D.DD
1440  !
1450  !    ACCUMULATE TOTALS
1460  !
1470       Total=Total+Price
1480       Master_total=Master_total+Price
1490     NEXT I
1500  !
1510  !   PRINT TRAILER FOR PRODUCT
1520  !
1530     PRINT TAB(54);
1540     PRINT USING Tot_image;VAL$(Prod_no),Total
1550     Total=0
1560     GOTO Start_report
1570  !
1580  !   PRINT FINAL TOTALS
1590  !
1600  End_report:PRINT USING Mstr_image; Master_total
1610     END
1620  Tot_image:IMAGE 9("=") / 3X,"TOTAL ORDERS FOR ",10A,24X, 6D.DD /
1630  Mstr_image:IMAGE // 25X,"TOTAL ORDERS",14X,"$"8D.DD / 54X,9("=")
1640  !
1650  !   DATABASE ERROR HANDLER
1660  !
1670  Dberr:DISP LIN(1);"UNEXPECTED DATABASE ERROR ";
             'VAL$(S(0));" IN LINE";S(6)
1680     END
In line 1070 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively.

Example Program 3

Example program 3 allows other users to perform write operations (DBPUT, DBDELETE, and DBUPDATE) by opening the database in mode 1. Other users can now open the database in mode 1 for reading. By using the locking capability, other programs can perform puts, deletes, and updates.

This program is basically an expansion of the previous example. The options for each order are listed by inserting a chained-access DBGET through the OPTION set for each order found in CUSTOMER. The DBFIND on the OPTION set (line 1470) using the order number from CUSTOMER finds the head of the chain of options. The FOR-NEXT loop (line 1490) then chains through the entries in the OPTION set, doing chained-mode DBGETS.

A significant feature of this program is the replacement of the UNPACK USING statements with IN DATA SETs. Lines 1180 through 1200 set up a correspondence between variables in the Eloquence program and fields in the data sets. Thus, when the DBGET on PRODUCT is performed (line 1310), the values of the fields PRODUCT-NO and PRODUCT-DESC in the PRODUCT set are automatically assigned to the variables Prod_no and Desc$. Similarly, when the DBGET in line 1500 is executed, new values are assigned to Option_desc$ and P0.

The use of SKP in the IN DATA SET for the OPTION set (line 1200) instructs the system to ignore the value of the ORDER-NO field. It is not assigned to any variable since this field was read by DBGET on the CUSTOMER set and assigned to Order_no$; reassigning it would be superfluous.

The USE ALL option on the IN DATA SET for the CUSTOMER set (line 1190) specifies that only fields whose names correspond to variables already in the program are to be unpacked into their corresponding variables.

Only the variables Order_no$ and Name$ in this program correspond to fields in the CUSTOMER set. Thus, when the DBGET in line 1410 is executed, only the value of the fields ORDER-NO and NAME are assigned to variables (Order_no$ and Name$, respectively).

Another feature of example program 3 is error control and program termination. Lines 1080 and 1090 allow the program to trap the HALT key and any error conditions and wrap-up gracefully. Both termination conditions, as well as the database routine, then attempt to close the database (line 1900). In this instance, however, the DBCLOSE is not critical. Had any write operations been performed, the close would be necessary to properly record the changes made to the database.

A mode 4 DBCLOSE is automatically executed when the program ENDs when the database is not closed prior to program completion. This close updates the data stored on the disk, but leaves the database open for further access. Certain operations, such as DBERASE, require exclusive access to the database, and cannot be performed until a mode 1 DBCLOSE is executed.

                       OUTSTANDING ORDERS LIST

PRODUCT    ORDER NUMBER      CUSTOMER NAME     OPTIONS     PRICE
---------------------------------------------------------------------
50   (Tricycle)
           110               Gissing, Malcomb              45.00
                                                          --------
                                                           45.00
                                                          ========
          TOTAL ORDERS FOR 50                              45.00

1000 (10-Speed Bicycle)
           102               Johnson, Sam                 150.00
                                                 Chrome    12.50
                                                          --------
                                                          162.50

           106               Heining, Heinz               150.00
                                                 Light     10.00
                                                 Basket    15.00
                                                          --------
                                                          175.00

           107               Dalling, Jimmy               150.00
                                                          --------
                                                          150.00
                                                          ========
          TOTAL ORDERS FOR 1000                           487.50

100  (Standard Bicycle)
          101                Noname, Joseph                75.00
                                                 Horn       2.50
                                                          --------
                                                           77.50

          103                Hernaned, Jose                75.00
                                                 Light      5.00
                                                 Mud Flaps  2.50
                                                 Horn      10.00
                                                 Stripes    2.50
                                                 Fan       10.00
                                                          --------
                                                          109.75

         108                 Arauja, Luciano A.            75.00
                                                 Horn       5.00
                                                          --------
                                                           80.00
                                                          ========
          TOTAL ORDERS FOR 100                            267.25
300  (3-Speed Bicycle)
         104                 Houseman, Sean               110.00
                                                 Light      5.00
                                                Super Tire 18.00
                                                          --------
                                                          133.00
                                                          ========
          TOTAL ORDERS FOR 300                            133.00

500  (5-Speed Bicycle)
         100                 Smith, Thomas A.             125.00
                                                 Light      5.00
                                                 Basket    45.00
                                                          --------
                                                          175.50

         105                 Sono, Jomo A.                125.00
                                                 Horn       2.50
                                                 Reflector  7.50
                                                          --------
                                                          135.00

         109                 Bekker, Bart                 125.00
                                                          --------
                                                          125.00
                                                          ========
          TOTAL ORDERS FRO 500                            435.50

                             TOTAL ORDERS               $1368.25
                                                        ==========
1000  !   EXAMPLE PROGRAM 3
1010  !
1020  !   OUTSTANDING ORDERS REPORT (INCLUDING ALL DETAIL)
1030  !
1040     INTEGER S(9), Product_no,Prod_no
1050     DIM B$[12],P$[10],Buf$[170]
1060     DIM Desc$[30],Order_no$[30],Name$[30],
                    Option_desc$[10]
1070     DISP "Cr/H Cl/S";        ! CLEAR SCREEN
1080     ON ERROR GOTO Error      ! SET UP ERROR AND HALT TRAPS
1090     ON HALT GOTO Halt
1100     B$="  SAD,SALES"
1110     P$="MANAGER"
1120     DBOPEN (B$,P$,1,S(*))     ! OPEN FOR SHARED ACCESS
1130     IF S(0) THEN Dberr
1140  !
1150  !   SET UP ALL APPROPRIATE RELATIONSHIPS
1160  !
1170     DBASE IS B$
1180     IN DATA SET "PRODUCT" USE Prod_no,Desc$
1190     IN DATA SET "CUSTOMER" USE ALL
1200     IN DATA SET "OPTION" USE SKP 1,Option_desc$,P0
1210  !
1220  !   INITIALIZE VARIABLES & PRINT REPORT HEADER
1230  !
1240  Rep:Total=Master_total=0
1250     Eof=11
1260     PRINT TAB(30);"OUTSTANDING ORDERS LIST";LIN(1)
1270     PRINT "PRODUCT";SPA(8);"ORDER NUMBER";SPA(10);
         "CUSTOMER NAME";SPA(9);"OPTIONS";SPA(8);"PRICE";
         LIN(1);RPT$("=",79);LIN(1)
1280  !
1290  !   PRODUCE THE REPORT
1300  !
1310  Start_report:DBGET (B$,"PRODUCT",2,S(*),"@",Buf$,0)
1320     IF S(0)=Eof THEN End_report
1330     IF S(0) THEN Dberr
1340  !
1350  !   PRINT HEADER FOR PRODUCT
1360  !
1370     PRINT VAL$(Prod_no);" (";TRIM$(Desc);")"
1380     DBFIND (B$,"CUSTOMER",1,S(*),"PRODUCT-NO,Prod_no)
1390     IF S(0) THEN Dberr
1400     FOR I=1 TO S(5)
1410       DBGET (B$,"CUSTOMER",5,S(*),"@",Buf$,0)
1420       IF S(0) THEN Dberr
1430  !
1440  !     PRINT HEADER FOR ORDER
1450  !
1460       PRINT TAB(20);Order_no$;TAB(38);Name$[1,21];
1470       DBFIND (B$,"OPTION",1,S(*),"ORDER-NO",Order_no$)
1480       IF S(0) THEN Dberr
1490       FOR J=1 TO S(5)
1500         DBGET (B$,"OPTION",5,S(*),"@",Buf$,0)
1510         IF S(0) Then Dberr
1520  !
1530  !      PRINT OPTIONS
1540  !
1550         PRINT TAB(60);
1560         PRINT USING Itm_image;Option_desc$,P0
1570  Itm_image:IMAGE 10A,2X,5D.DD
1580  !
1590  !      ACCUMULATE TOTALS
1600  !
1610         Total=Total+P0
1620         Sub_total=Sub_total+P0
1630         Master_total=Master_total+P0
1640       NEXT J
1650       PRINT TAB(71);
1660       PRINT USING Sub_image;Sub_total
1670       Sub_total=0
1680     NEXT I
1690  !
1700  !   PRINT TRAILER FOR PRODUCT
1710  !
1720     PRINT TAB(70);
1730     PRINT USING Tot_image;VAL$(Prod_no),Total
1740     Total=0
1750     GOTO Start_report
1760  !
1770  !   PRINT FINAL TOTALS
1780  !
1790  End_report:PRINT USING Mstr_image;Master_total
1800     GOTO Close
1810  Sub_image:IMAGE 8("-") / 71X,5D.DD /
1820  Tot_image:IMAGE 9("=") / 11X,"TOTAL ORDERS FOR ",10A,32X,6D.DD /
1830  Mstr_image:IMAGE // 31X,"TOTAL ORDERS",24X,"$"8D.DD / 70X,9("=")
1840  !
1850  !     ERROR AND HALT TERMINATION ROUTINES
1860  !!
1870  Dberr:DISP LIN(2);"STATUS ERROR ";VAL$(S(0));" IN LINE"; S(6)
1880     GOTO Close
1890  Error: DISP LIN(2);"UNEXPECTED ";ERRM$
1900     GOTO Close
1910  Halt:PRINT LIN(2)
1920  Close:DBCLOSE (B$," ",1,S(*))
1930     DISP LIN(2);"END OF OUTSTANDING ORDERS REPORT."
1940     END
In line 1070 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively.

Example Program 4

The last two programs are used to enter new products into the database and make modifications and deletions to existing products. Example program 4 allows new products to be added to the database. Since write operations must be performed, the database is opened in mode 3 (see line 1130). This program also contains the necessary lines to trap HALTs and errors (see lines 1090 and 1100).

When the program is first RUN it produces a screen like that shown below.

Press EXIT PROGRAM to terminate the program. Otherwise, a new product number is entered and the program prompts for a product description. Note that the set capacity and the current number of entries are displayed. This information is obtained via DBINFO in line 1330. Note also that since the result of DBINFO is left in the buffer, an UNPACK is used (line 1350) to extract these values into integer variables. Since integers range from -231 through +231-1 and capacities range from 1 through 999,999, a conversion is necessary. The FNCorrect function defined in line 1240 provides this conversion.

The same would be possible using a DINTEGER variable to unpack instead of 2 INTEGERS.

If a duplicate product number is entered, the program displays an error and prompts for a correction. For example:

This duplicity is detected by attempting a calculated access (line 1460) of the master for the product using the given product number.

If the specified product is not found, the product description is requested as shown here:

After the description is entered, a DBPUT (line 1600) is used to store the new product in the database. The program then reports that the DBPUT was successful and gives two options which are key selected.

The user can either add ANOTHER product or EXIT the program.

1000  !   EXAMPLE PROGRAM 4
1010  !
1020  !   ADD NEW PRODUCT
1030  !
1040     INTEGER S(9),Prod_no,Entries,Capacity,Entries2,Capacity2
1050     DIM B$[12],P$[10],Buf$[170]
1060     DIM Desc$[30]
1070     DISP "Cr/H Cl/S";        ! CLEAR SCREEN
1080     DISP TAB(32);"ADD NEW PRODUCT'
1090     ON ERROR GOTO Error       !SET UP ERROR AND HALT TRAPS
1100     ON HALT GOTO Halt
1110     B$="  SAD,SALES"
1120     P$="MANAGER"
1130     DBOPEN (B$,P$,3,S(*))     ! OPEN FOR EXCLUSIVE ACCESS
1140     IF S(0) THEN Dberr
1150  !
1160  !   SET UP ALL APPROPRIATE RELATIONSHIPS
1170  !
1180     DBASE IS B$
1190     IN DATA SET "PRODUCT" USE Prod_no,Desc$
1200  !
1210  !   FUNCTION TO CONVERT TWO 16-BIT INTEGERS TO
1220  !   ONE 32-BIT INTEGER
1230  !
1240     DEF FNCorrect(INTEGER N,N2)=N2+N*65536
1250  !
1260  !   INITIALIZE
1270  !
1280     Not_found=17
1290     ON KEY #8:"EXIT" GOTO Halt
1300     ON KEY #16 GOTO Halt
1310  Cont:DISP "Cr/H";LIN(3);"Cl/S";LIN(10)
1320     OFF KEY #1,9
1330     DBINFO (B$,"PRODUCT",202,S(*),Buf$)
1340     UNPACK USING Fmt;Buf$
1350  Fmt:PACKFMT 28X,Entries,Entries2,Capacity,Capacity2
1360     DISP "CURRENT NUMBER OF ENTRIES :";FNCorrect(Entries,Entries2);
               LIN(2)
1370     DISP "SET CAPACITY:            ";FNCorrect(Capacity,Capacity2)
1380  !
1390  !   ASK FOR NEW PRODUCT NUMBER
1400  !
1410  Again:DISP "Cr/H";LIN(3)
1420     Badp=-1                 ! ALLOW FOR A NULL USER RESPONSE.
1430     INPUT "Enter the number of the product you wish to add.",
               Prod_no
1440     IF Prod_no%<1 THEN Badp
1450     DBGET (B$,"PRODUCT",7,S(*),"@",Buf$,Prod_no)
1460     IF S(0)=Not_found THEN Enter
1470     IF S(0) THEN Dberr
1480     DISP "PRODUCT ALREADY IN DATABASE."
1490     BEEP
1500     GOTO Again
1510  Badp:DISP "ILLEGAL PRODUCT NUMBER"
1520     BEEP
1530     GOTO Again
1540  !
1550  !   PUT THE NEW PRODUCT IN THE DATABASE
1560  !
1570  Enter:DISP "Cl/S"
1580     INPUT "Enter product description",Desc$
1590     DBPUT (B$,"PRODUCT",1,S(*),"@",Buf$)
1600     IF S(0) THEN Dberr
1610     DISP "NEW PRODUCT ADDED."
1620     ON KEY #1:"ANOTHER GOTO Cont
1630     ON KEY #9 GOTO Cont
1640     WAIT
1650  Dberr:DISP LIN(2);"STATUS ERROR ";VAL$(S(0));" IN LINE";
                S(6)
1660     GOTO Close
1670  Error:DISP LIN(2);"UNEXPECTED ";ERRM$
1680     GOTO Close
1690  Halt:DISP "    END OF ADD PRODUCT PROGRAM."
1700  Close:DBCLOSE (B$," ",1,S(*))
1710     END
In lines 1070, 1310, 1570 and 1690 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively.

Example Program 5

Example program 5 allows products in the PRODUCT data set to be changed or deleted. The program prompts for the number of the product to be edited. The EXIT key can be pressed at any time to stop the program. The initial display is as follows:

If a number is entered for a non-existent product, it is detected by the calculated access DBGET in line 1330, as shown by the following screen:

Note that the database was opened in mode 1. Line 1310 locks the database. It is essential that the database be locked before the DBGET. If it is locked afterwards, another user could lock the database anytime before the lock in this program and then make modifications to the record retrieved in line 1330. If such a user deleted the record, a subsequent DBUPDATE or DBDELETE would fail.

Once a correct product number has been provided, the old description is displayed for user edit:

The ANOTHER key can be pressed here to abort the modification and return to the initial display.

If the description is altered and RETURN is pressed, the DBUPDATE line (1520) alters the text of the product description in the database. In this case, either ANOTHER or EXIT PROGRAM is pressed to continue:

If the DELETE key is pressed, the product is removed from the database (see line 1670). The program then indicates that the delete was successful and waits for the user to respond with the appropriate key:

If the entry in the PRODUCT master had any entries associated with it in the CUSTOMER detail, an error would have been issued (see line 1690).

Note that extreme care must be taken so that DBUNLOCKs are performed either after a successful operation or following an error (see lines 1350, 1550 and 1600). The DBCLOSE in line 1780 automatically performs the unlock in case either HALT or EXIT PROGRAM is pressed or an unforeseen error occurs.

1000  !   EXAMPLE PROGRAM 5
1010  !
1020  !   PRODUCT EDITOR
1030  !
1040     INTEGER S(9),Prod_no
1050     DIM B$[12],Buf$[170]
1060     DIM Desc$[30]
1070     DISP "Cr/H Cl/S";        ! CLEAR SCREEN
1080     DISP TAB(34);"EDIT PRODUCT"
1090     ON ERROR GOTO Error       ! SET UP ERROR AND HALT TRAPS
1100     ON HALT GOTO Halt
1110     B$="  SAD,SALES"
1120     P$="MANAGER"
1130     DBOPEN (B$,P$,1,S(*)      ! OPEN FOR SHARED ACCESS
1140     IF S(0) THEN Dberr
1150  !
1160  !   SET UP ALL APPROPRIATE RELATIONSHIPS
1170  !
1180     DBASE IS B$
1190     IN DATA SET "PRODUCT" USE Prod_no,Desc$
1200  !
1210  !   INITIALIZE AND ASK FOR PRODUCT NUMBER
1220  !
1230     Not_found=17
1240     Chain_not_empty=44
1250     ON KEY #8:"EXIT" GOTO Halt
1260     ON KEY #16 GOTO Halt
1270  Cont:DISP "Cr/H";LIN(3);"Cl/S";
1280     OFF KEY #1,9
1290  Again:DISP "Cr/H";LIN(3);
1300     INPUT "Enter the number of the product you wish to edit.",
                 Prod_no
1310     DBLOCK (B$," ",1,S(*))     ! LOCK DATABASE BEFORE WRITE
1320     IF S(0) THEN Dberr
1330     DBGET (B$,"PRODUCT",7,S(*),"@",Buf$,Prod_no)
1340     IF S(0) %<> Not_found THEN Maybe
1350     DBUNLOCK (B$," ",1,S(*))!UNLOCK THE DATABASE AFTER AN ERROR
1360     IF S(0) THEN Dberr
1370     DISP "NO SUCH PRODUCT IN DATABASE."
1380     BEEP
1390     GOTO Again
1400  Maybe:IF S(0) THEN Dberr
1410  !
1420  !   GET NEW DESCRIPTION AND PERFORM THE UPDATE
1430  !
1440     DISP "Cl/S"
1450     Desc$=Trim$(Desc$)
1460     ON KEY #5:"DELETE" GOTO Del
1470     ON KEY #13 GOTO Del
1480     EDIT "Enter New description",Desc$
1490     OFF KEY #5,13
1500     DBUPDATE (B$,"PRODUCT",1,S(*),"@",Buf$)
1510     IF S(0) THEN Dberr
1520     DISP "UPDATE COMPLETE."
1530  WAIT:DBUNLOCK (B$," ",1,S(*)) ! UNLOCK DATABASE AFTER WRITE
1540     IF S(0) THEN Dberr
1550     ON KEY #1:"ANOTHER GOTO Cont
1560     ON KEY #9 GOTO Cont
1570     WAIT
1580  !
1590  !   DELETE THE ENTRY
1600  !
1610  Del:OFF KEY #5,13
1620     DBDELETE (B$,"PRODUCT',1,S(*))
1630     IF S(0) %<>Chain_not_empty THEN Del2
1640     DISP LIN(1);"THERE ARE STILL ORDERS FOR THIS PRODUCT."
1650     BEEP
1660     GOTO Wait
1670  De12:IF S(0) THEN Dberr
1680     DISP LIN(1);"PRODUCT DELETED."
1690     GOTO Wait           ! GO DO UNLOCK.
1700  !
1710  !   TERMINATION ROUTINES
1720  !
1730  Dberr:DISP LIN(2);"STATUS ERROR ";VAL$(S(0));" IN LINE";
             S(6)
1740     GOTO Close
1750  Error:DISP LIN(2);"UNEXPECTED ";ERRM$
1760     GOTO Close
1770  Halt:DISP "Cr/H END OF EDIT PRODUCT PROGRAM."
1780  Close:DBCLOSE (B$," ",1,S(*))
1790     END
In lines 1070, 1270, 1290, 1440 and 1770 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively.


Eloquence Database Manual - 19 DEC 2002