home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: Product
/
Product.zip
/
DBDEMO.ZIP
/
DEMODB.ZIP
/
D30ABBC1.SQB
< prev
next >
Wrap
Text File
|
1989-10-31
|
31KB
|
783 lines
******************************************IBM CONFIDENTIAL*******
* *
* APPLICATION PROGRAM NAME: D30ABBC1.SQB OF D30ABB01 *
* *
* PROGRAM LANGUAGE: COBOL PROGRAMMING LANGUAGE Version 1.00 *
* *
* PROGRAM DESCRIPTION: This program creates several views *
* using the BANK Database tables. After the views are *
* created, the data for the tables is imported through *
* engine. The Signal Handler is installed. *
* *
* AUTHOR: John A. Vargus DATE: 02/02/89 *
* *
* AUTHORITY: *
* USERID:USERID *
* PASSWORD:PASSWORD *
* *
* DATABASE: Shelby BANK Database *
* Tables: Customer/Box/Loan/Debits/Credits *
* Savings/Checking *
* *
* OUTPUT FILES: ERRFIL - This file is created, on disk, when *
* some type of error condition is returned from *
* SQL. In the error file, the sqlcode will *
* be recorded, its corresponding error message, *
* and the procedure which failed. *
* *
* DEPENDENCIES: *
* OS/2 EE REL 1.2. *
* ENGINE *
* SQLCA.CBL (current directory). *
* IBM COBOL/2 VERSION 1.00 *
* *
* FUNCTION CALLS: *
* "__SQLGISIG" *
* "__SQLGSTRD" *
* "__SQLGREST" *
* "__SQLGIMP" *
* *
* EMBEDDED SQL: *
* Create view *
* Select/From/Where *
* Execpt *
* Intersect *
* Commit *
* Union *
* RollBack Work *
* *
* ERROR CONDITIONS: *
* *
* *
* MODIFICATIONS: *
* Date Author Description *
* *
***********************End of Prologue***************************
*****************************************************
Identification Division.
Program-id. D30ABBC1.SQB.
Author. John Vargus.
Installation.
Date-written. March 3,1988.
Date-compiled. March 3,1988.
Security. None.
*****************************************************
Environment Division.
****************************************************
Configuration section.
Source-computer. PCAT.
Object-computer. PCAT.
Special-names.
File-Control.
select errfil
assign to disk.
*****************************************************
Data Division.
***********************Begin file control************
File section.
*---------------------------------------------------
FD errfil
record contains 80 characters
label records are omitted
data record is line-out.
01 line-out pic x(80).
***********************Begin Working-Storage Section*
Working-storage section.
*----------------------------------------------------
* Parameter declarations
*----------------------------------------------------
77 database pic x(5) value "BANK".
77 db-length pic 9(4) comp-5 value 4.
77 d-use pic 9(4) comp-5.
77 u pic x redefines d-use.
77 count-d pic 9(4) comp-5 value 2.
77 spare1 pic 9(4) comp-5 value 0.
77 spare2 pointer.
77 buffer-size pic 9(4) comp-5 value 512.
77 buffer pic x(512).
77 line-width pic 9(4) comp-5 value 80.
*----------------------------------------------------
copy "c:\sqllib\sqlca.cbl".
copy "c:\sqllib\sqlutil.cbl".
copy "c:\sqllib\sqlenv.cbl".
*----------------------------------------------------
* Program Constants
*----------------------------------------------------
78 testcase-name value "Test Case:D30ABBC1".
78 description value "Create Views and Import data ".
77 error-handler-t0-f1 pic x value "1".
*----------------------------------------------------
* Import Filenames and Tclostrg
*----------------------------------------------------
77 imp-cust pic x(13) value "customer.wrk".
77 imp-box pic x(12) value "box.wr1".
77 imp-loan pic x(12) value "loan.wks".
77 imp-sav pic x(12) value "savings.wks".
77 imp-chck pic x(13) value "checking.wk1".
*
77 ins-cust pic x(20) value "insert into customer".
77 ins-box pic x(20) value "insert into box".
77 ins-loan pic x(20) value "insert into loan".
77 ins-sav pic x(20) value "insert into savings".
77 ins-chck pic x(20) value "insert into checking".
*
77 custmsg pic x(12) value "custmsg.msg".
77 boxmsg pic x(12) value "boxmsg.msg".
77 loanmsg pic x(12) value "loanmsg.msg".
77 savmsg pic x(12) value "savemsg.msg".
77 chckmsg pic x(12) value "chckmsg.msg".
*----------------------------------------------------
* Import/Export declarations
*----------------------------------------------------
77 mf-length pic 9(4) comp-5.
77 ft-length pic 9(4) comp-5.
77 df-length pic 9(4) comp-5.
77 caller-action pic 9(4) comp-5 value 0.
77 msgfile pic x(13).
77 datafile pic x(13).
77 filetype pic x(4).
*
01 dcoldata.
05 dcolmeth pic x(2) value SQL-METH-D.
05 dcolnum pic 9(4) comp-5.
05 dcoln occurs 1 times depending on dcolnum.
10 dcoln-len pic 9(4) comp-5.
10 dcoln-ptr pointer.
*
01 filetmod.
05 filetmod-len pic 9(4) comp-5.
05 filetmod-str pic x(20).
*
01 tcolstrg.
05 tcolstrg-len pic 9(4) comp-5.
05 tcolstrg-str pic x(21).
*----------------------------------------------------
* Output file declarations
*----------------------------------------------------
01 error-report-out1.
05 Testcase-name-out pic x(21).
05 filler pic x(4).
05 descrip-out pic x(54).
01 error-report-out2.
05 filler pic x(10) value "Procedure:".
05 routine-label pic x(20).
05 filler pic x(12) value " SQLCODE:".
05 sqlcode-out pic 9(9).
05 filler pic x(28).
01 error-report-out3.
05 buffer-out pic x(512).
05 filler pic x(10).
***********************End Working-Storage Section***
*----------------------------------------------------
***********************Begin Procedure Division******
Procedure division.
*----------------------------------------------------
Exec sql
whenever sqlerror go to sqerr
end-exec.
*
exec sql
whenever sqlwarning continue
end-exec.
*
exec sql
whenever not found continue
end-exec.
*
Perform initialization.
display "Starting Signal Handler".
Perform signal-handler.
If error-handler-t0-f1 is equal to "1"
Display "Start using database "
Perform start-using-db.
If error-handler-t0-f1 is equal to "1"
Display "Alter table for foreign keys"
Perform alter-foreign-key.
If error-handler-t0-f1 is equal to "1"
Display "revoking public"
Perform revoke-public.
If error-handler-t0-f1 is equal to "1"
Display "Granting Privilege"
Perform grant-privilege.
If error-handler-t0-f1 is equal to "1"
Display "creating view 1"
Perform create-view1.
If error-handler-t0-f1 is equal to "1"
Display "creating view 2"
Perform create-view2.
If error-handler-t0-f1 is equal to "1"
Display "Creating view 3"
Perform create-view3.
If error-handler-t0-f1 is equal to "1"
Display "Creating view 4"
Perform create-view4.
If error-handler-t0-f1 is equal to "1"
Display "Creating view 5"
Perform create-view5.
If error-handler-t0-f1 is equal to "1"
Display "Creating view 6"
Perform create-view6.
If error-handler-t0-f1 is equal to "1"
Display "Creating view 7"
Perform create-view7.
If error-handler-t0-f1 is equal to "1"
Display "Importing customer data"
Perform customer-table-import.
If error-handler-t0-f1 is equal to "1"
Display "Importing box data"
Perform box-table-import.
If error-handler-t0-f1 is equal to "1"
Display "Importing loan data"
Perform loan-table-import.
If error-handler-t0-f1 is equal to "1"
Display "Importing savings data"
Perform savings-table-import.
If error-handler-t0-f1 is equal to "1"
Display "Importing checking data"
Perform checking-table-import.
If error-handler-t0-f1 is equal to "1"
Perform stop-db.
If error-handler-t0-f1 is equal to "0"
display "You have an error please check the file ERRFIL".
Perform end-run.
***********************End of Procedure Division****
****************************************************
* Procedures *
****************************************************
***********************Begin Procedure**************
initialization.
*---------------------------------------------------
move testcase-name to testcase-name-out.
move description to descrip-out.
move 0 to filetmod-len.
move "S" to u.
***********************End Procedure****************
***********************Begin Procedure**************
signal-handler.
*--------------------------------------------------
call "__sqlgisig" using
sqlca.
move "Signal Handler" to routine-label.
if sqlcode is less than 0
perform sqlerrorhandler.
***********************End Procedure****************
***********************Begin Procedure**************
start-using-db.
*---------------------------------------------------
call "__sqlgstrd" using
database
spare2
sqlca
by value d-use
by value db-length
by value spare1.
move "start using db1" to routine-label.
if sqlcode equal -1015
perform restart-db.
if sqlcode not equal 0
perform sqlerrorhandler.
***********************End Procedure****************
***********************Begin Procedure**************
restart-db.
*--------------------------------------------------
move "resart db " to routine-label.
call "__sqlgrest" using
database
spare2
sqlca
by value db-length
by value spare1.
*
if sqlcode is not equal to 0
perform sqlerrorhandler.
*
If error-handler-t0-f1 is equal to "1"
move "start using db2" to routine-label
call "__sqlgstrd" using
database
spare2
sqlca
by value d-use
by value db-length
by value spare1
if sqlcode is not equal to 0
perform sqlerrorhandler.
***********************End Procedure****************
***********************Begin Procedure**************
alter-foreign-key.
*--------------------------------------------------
move "alter foreign key" to routine-label.
*
exec sql
alter table savings foreign key sssn (s_ssn) references
customer on delete restrict
end-exec.
*
exec sql
alter table loan foreign key lssn (l_ssn) references
customer on delete restrict
end-exec.
*
exec sql
alter table checking foreign key cssn (c_ssn1) references
customer on delete restrict
end-exec.
*
exec sql
alter table debits foreign key dacct (db_accnumb)
references checking on delete cascade
end-exec.
*
exec sql
alter table credits foreign key cacct (cr_accnumb)
references checking on delete cascade
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
revoke-public.
*--------------------------------------------------
move "revoke public" to routine-label.
*
exec sql
revoke createtab on database from public
end-exec.
*
exec sql
revoke bindadd on database from public
end-exec.
*
exec sql
revoke connect on database from public
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
grant-privilege.
*--------------------------------------------------
move "granting privil" to routine-label.
*
exec sql
grant dbadm on database to gdbadm, badmin
end-exec.
*
exec sql
grant connect, bindadd on database to gprep, prep
end-exec.
*
exec sql
grant connect, createtab on database to gcreate, tcreate
end-exec.
*
exec sql
grant connect on database to gqrysel, qrysel, gedit,
tedit, gtvcon, tvcon, gselins, selins, refer, tdelete,
tupdate, selupdel, texecute, editalt
end-exec.
*
exec sql
grant select on table customer to gqrysel, qrysel
end-exec.
*
exec sql
grant select, update, insert, delete on table customer
to gedit, tedit
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
create-view1.
*---------------------------------------------------
move "create view vloan" to routine-label.
*
exec sql
create view vloan as
select cu_ssn,cu_name,cu_addr1,cu_addr2,cu_zip,l_numb,
l_type,l_rate,l_paymt,l_bal,l_intodat,l_descrip,
l_date,l_ssn,l_term
from customer, loan
where customer.cu_ssn = loan.l_ssn
end-exec.
*
exec sql
commit work
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
create-view2.
*---------------------------------------------------
move "create view vsave" to routine-label.
*
exec sql
create view vsave as
select cu_ssn,cu_name,s_inttod,s_accnumb,s_bal,s_ssn
from customer, savings
where customer.cu_ssn = savings.s_ssn
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
create-view3.
*---------------------------------------------------
move "create view viewbox" to routine-label.
*
exec sql
create view viewbox as
select b_numb, b_size, b_rent
from box
where b_size = 'N'
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
create-view4.
*---------------------------------------------------
move "create view viewcust" to routine-label.
*
exec sql
create view viewcust as
select *
from newcust
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
create-view5.
*---------------------------------------------------
move "create view solloan" to routine-label.
*
exec sql
create view solloan (ssn, ssnsc) as
((select cu_ssn, s_ssn
from customer, savings
where (cu_ssn = s_ssn) and (s_bal > 1000.00))
*
intersect
*
(select cu_ssn, c_ssn1
from customer, checking
where (cu_ssn = c_ssn1) and (c_endbal > 1000.00))
*
except
*
(select cu_ssn, l_ssn
from customer, loan
where cu_ssn = l_ssn))
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
create-view6.
*---------------------------------------------------
move "create view chkact" to routine-label.
*
exec sql
create view chkact (accnumb) as
((select c_accnumb
from checking
where c_accnumb not in (select db_accnumb from debits))
*
intersect
*
(select c_accnumb
from checking
where c_accnumb not in (select cr_accnumb
from credits)))
end-exec.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
create-view7.
*---------------------------------------------------
move "create view inactcus" to routine-label.
*
exec sql
create view inactcus (ssn) as
(select cu_ssn
from customer
where cu_ssn not in ((select c_ssn1 from checking)
union
(select s_ssn from savings)
union
(select l_ssn from loan)
union
(select b_ssn from box)))
end-exec.
*
exec sql
commit work
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
customer-table-import.
*---------------------------------------------------
move "importing customer data" to routine-label.
*
move 21 to tcolstrg-len.
move ins-cust to tcolstrg-str.
move custmsg to msgfile.
move imp-cust to datafile.
move "WSF" to filetype.
move 12 to df-length.
move 11 to mf-length.
move 3 to ft-length.
*
call "__sqlgimp" using
database
spare2
imp-cust
dcoldata
tcolstrg
filetype
filetmod
msgfile
sqlca
by value caller-action
by value db-length
by value spare1
by value df-length
by value ft-length
by value mf-length.
if sqlcode is less than 0
perform sqlerrorhandler.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
box-table-import.
*---------------------------------------------------
move "importing box data" to routine-label.
*
move 20 to tcolstrg-len.
move ins-box to tcolstrg-str.
move boxmsg to msgfile.
move imp-box to datafile.
move "WSF" to filetype.
move 7 to df-length.
move 10 to mf-length.
move 3 to ft-length.
*
call "__sqlgimp" using
database
spare2
datafile
dcoldata
tcolstrg
filetype
filetmod
msgfile
sqlca
by value caller-action
by value db-length
by value spare1
by value df-length
by value ft-length
by value mf-length.
if sqlcode is less than 0
perform sqlerrorhandler.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
loan-table-import.
*---------------------------------------------------
move "importing loan data" to routine-label.
*
move 20 to tcolstrg-len.
move ins-loan to tcolstrg-str.
move loanmsg to msgfile.
move imp-loan to datafile.
move "WSF" to filetype.
move 8 to df-length.
move 11 to mf-length.
move 3 to ft-length.
*
call "__sqlgimp" using
database
spare2
datafile
dcoldata
tcolstrg
filetype
filetmod
msgfile
sqlca
by value caller-action
by value db-length
by value spare1
by value df-length
by value ft-length
by value mf-length.
if sqlcode is less than 0
perform sqlerrorhandler.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
savings-table-import.
*---------------------------------------------------
move "importing savings data" to routine-label.
*
move 20 to tcolstrg-len.
move ins-sav to tcolstrg-str.
move savmsg to msgfile.
move imp-sav to datafile.
move "WSF" to filetype.
move 11 to df-length.
move 11 to mf-length.
move 3 to ft-length.
*
call "__sqlgimp" using
database
spare2
datafile
dcoldata
tcolstrg
filetype
filetmod
msgfile
sqlca
by value caller-action
by value db-length
by value spare1
by value df-length
by value ft-length
by value mf-length.
if sqlcode is less than 0
perform sqlerrorhandler.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
checking-table-import.
*---------------------------------------------------
move "importing checking data" to routine-label.
*
move 20 to tcolstrg-len.
move ins-chck to tcolstrg-str.
move chckmsg to msgfile.
move imp-chck to datafile.
move "WSF" to filetype.
move 12 to df-length.
move 11 to mf-length.
move 3 to ft-length.
*
call "__sqlgimp" using
database
spare2
datafile
dcoldata
tcolstrg
filetype
filetmod
msgfile
sqlca
by value caller-action
by value db-length
by value spare1
by value df-length
by value ft-length
by value mf-length.
if sqlcode is less than 0
perform sqlerrorhandler.
*
exec sql
commit
end-exec.
***********************End Procedure****************
***********************Begin Procedure**************
stop-db.
*---------------------------------------------------
call "__sqlgstpd" using
sqlca.
*
move "Stop Db" to routine-label.
if sqlcode is less than 0
perform sqlerrorhandler.
***********************End Procedure****************
***********************Begin Procedure**************
sqlerrorhandler.
*---------------------------------------------------
call "__sqlgintp" using
buffer
sqlca
by value line-width
by value buffer-size.
move 0 to error-handler-t0-f1
move sqlcode to sqlcode-out
move buffer to buffer-out.
open output errfil.
move error-report-out1 to line-out.
write line-out after advancing 1 line.
move error-report-out2 to line-out.
write line-out after advancing 1 line.
move error-report-out3 to line-out.
write line-out after advancing 1 line.
perform roll-back-work.
close errfil.
move 1 to return-code.
***********************Begin Procedure**************
roll-back-work.
*---------------------------------------------------
exec sql
whenever sqlerror continue
end-exec.
*
exec sql
rollback work
end-exec.
*
if sqlcode is less than 0
move "Rollback failed" to routine-label
move sqlcode to sqlcode-out
move error-report-out2 to line-out.
write line-out after advancing 1 line.
*---------------------------------------------------
sqerr.
*---------------------------------------------------
perform sqlerrorhandler.
perform stop-db.
perform end-run.
***********************BEGIN PROCEDURE**************
end-run.
*--------------------------------------------------
stop run.
