APPENDIX E - EXAMPLE OF ADA CODE GENERATED BY ADABAS NATIVE
SQL
with TYPES, ADABAS_GENERIC_CALLS, TEXT_IO ;
use TYPES, TEXT_IO ;
--
-- AN EXAMPLE OF SOFT COUPLING WITH A SEARCH CRITERION WHICH
-- CONTAINS FIELDS TAKEN FROM TWO FILES. THE FIELDS PERSONNEL-ID
-- NAME, FIRST-NAME, BIRTH AND SEX (FROM THE MAIN FILE,
-- PERSONNEL-ID) ARE PRINTED FOR RECORDS THAT SATISFY THE
-- FOLLOWING CONDITION:
-- PERSONNEL-ID BETWEEN 10000001 AND 19999999
-- MODEL-VEAR-MAKE >
-- CLASS = 'C'
procedure AEX1 is
START_MODEL : STRING (1..20) := "MERCEDES-BENZ ";
START_YEAR_MAKE : STRING (1..2) := "86" ;
START_MODEL_YEAR_MAKE : STRING(1..22) := START_MODEL &
START_YEAR_MAKE ;
FILLE1 : STRING(1..20) := " PERSONNEL-ID " ;
FILLE2 : STRING(1..17) := " NAME " ;
FILLE3 : STRING(1..18) := " FIRST-NAME " ;
FILLE4 : STRING(1..6) := "BIRTH " ;
FILLE5 : STRING(1..3) := "SEX" ;
HEADER : STRING(1..64) := FILLE1 & FILLE2 & FILLE3 & FILLE4
& FILLE5 ;
HEADER2: STRING(1..64) := (1..64 => '*');
SPACE_LINE : STRING(1..80) := (1..80 => ' ');
--
-- EXEC ADABAS
-- BEGIN DECLARE SECTION
-- END-EXEC
--
ADACODE : SHORT_INTEGER := 0 ;
CB_OPN : CONTROL_BLOCK :=
(FILLER1 => "AS" ,
COMMAND_CODE => " " ,
COMMAND_ID => "OPEN" ,
FILE_NUMBER => 0,
RESPONSE_CODE => 0,
ISN => 0,
ISN_LOWER_LIMIT => 0,
ISN_QUANTITY => 0,
FORMAT_BUFFER_LENGTH => 0,
RECORD_BUFFER_LENGTH => 0,
SEARCH_BUFFER_LENGTH => 0,
VALUE_BUFFER_LENGTH => 0,
ISN_BUFFER_LENGTH => 4,
COMMAND_OPTION_1 => " " ,
COMMAND_OPTION_2 => " " ,
ADDITIONS_1 => " ",
ADDITIONS_2 => " " ,
ADDITIONS_3 => " ",
ADDITIONS_4 => " ",
ADDITIONS_5 => " ",
COMMAND_TIME => 0,
USER_AREA => "AS " ) ;
FORMAT_BUF_OPN : FORMAT_BUFFER (1..0001) ;
SEARCH_BUF_OPN : SEARCH_BUFFER (1..0001) ;
VB_OPN : VALUE_BUFFER (1..0001) ;
RB_OPN : RECORD_BUFFER (1..1500) ;
ISN_BUF_OPN : ISN_BUFFER (1..0001) ;
package A_OPN is new ADABAS_GENERIC_CALLS
(FORMAT_BUFFER,RECORD_BUFFER,SEARCH_BUFFER,VALUE_BUFFER) ;
DDFILE : STRING(1..3) := "061" ;
CSEQ : STRING(1..8) ;
CLN1 : CLN_TYPE ;
CLN2 : CLN_TYPE ;
TRCE : STRING(1..7) ;
CLNNUM : SHORT_INTEGER ;
SQLRSP : SHORT_INTEGER ;
SQLQTY : INTEGER ;
SQLISN : INTEGER ;
type FORMAT_BUFEMPL_1 is
record
FILLE001 : STRING(1..32) :="AA,8,A,AE,20,A,AC,20,A,AH,6,U,AG";
FILLE002 : STRING(1..05) :=",1,A.";
end record ;
FORMAT_BUFEMPL : FORMAT_BUFEMPL_1 ;
type SEARCH_BUFEMPL_1 is
record
FILLE001 : STRING(1..32) :="(22,AA,24,AC)/22/AA,8,A,S,AA,8,A";
FILLE002 : STRING(1..27) :=",D,/24/AO,22,A,GT,D,AH,1,A.";
end record ;
SEARCH_BUFEMPL : SEARCH_BUFEMPL_1 ;
type RECORD_BUFEMPL is
record
PERSONNEL_ID : STRING (1..0008) ;
NAME : STRING (1..0020) ;
FIRST_NAME : STRING (1..0020) ;
BIRTH : STRING (1..0006) ;
SEX : STRING (1..0001) ;
ISN : INTEGER ;
QUANTITY : INTEGER ;
RESPONSE_CODE : SHORT_INTEGER ;
end record ;
EMPLOYEES : RECORD_BUFEMPL ;
type VALUE_BUFEMPL is
record
V_PERSONNEL_ID_F : STRING (1..0008)
:= (1..0008 => ' ' ) ;
V_PERSONNEL_ID_T : STRING (1..0008)
:= (1..0008 => ' ' ) ;
V_MODEL_YEAR_MAKE : STRING (1..0022)
:= (1..0022 => ' ' ) ;
V_CLASS : STRING (1..0001)
:= (1..0001 => ' ' ) ;
end record ;
VBEMPL : VALUE_BUFEMPL ;
ISN_BUFEMPL : ISN_BUFFER (1..0001) ;
package AEMPL is new ADABAS_GENERIC_CALLS
(FORMAT_BUFEMPL_1,RECORD_BUFEMPL,SEARCH_BUFEMPL_1,VALUE_BUFEMPL) ;
CBEMPL : CONTROL_BLOCK :=
(FILLER1 => "AS" ,
COMMAND_CODE => " " ,
COMMAND_ID => "EMPL" ,
FILE_NUMBER => 22,
RESPONSE_CODE => 0,
ISN => 0,
ISN_LOWER_LIMIT => 0,
ISN_QUANTITY => 0,
FORMAT_BUFFER_LENGTH => 37,
RECORD_BUFFER_LENGTH => 55,
SEARCH_BUFFER_LENGTH => 59,
VALUE_BUFFER_LENGTH => 39,
ISN_BUFFER_LENGTH => 4,
COMMAND_OPTION_1 => " " ,
COMMAND_OPTION_2 => " " ,
ADDITIONS_1 => " ",
ADDITIONS_2 => " " ,
ADDITIONS_3 => " ",
ADDITIONS_4 => " ",
ADDITIONS_5 => " ",
COMMAND_TIME => 0,
USER_AREA => "AS " ) ;
ISNSIZEEMPL : INTEGER ;
ISNMOREEMPL : INTEGER ;
ISNINDEMPL : INTEGER ;
EOFEMPL : BOOLEAN := FALSE ;
--
-- EXEC ADABAS
-- DECLARE EMPL CURSOR FOR
-- SELECT PERSONNEL-ID, NAME, FIRST-NAME, BIRTH, SEX
-- FROM EMPLOYEES, VEHICLES
-- WHERE EMPLOYEES.PERSONNEL-ID = VEHICLES.PERSONNEL-ID
-- AND PERSONNEL-ID BETWEEN "10000001" AND "19999999"
-- AND VEHICLES.MODEL-YEAR-MAKE > :START_MODEL_YEAR_MAKE
-- AND VEHICLES.CLASS = "C"
-- END-EXEC
--
begin
--
-- EXEC ADABAS
-- OPEN EMPL
-- END-EXEC
--
VBEMPL.V_PERSONNEL_ID_F := "10000001" ;
VBEMPL.V_PERSONNEL_ID_T := "19999999" ;
VBEMPL.V_MODEL_YEAR_MAKE := START_MODEL_YEAR_MAKE ;
VBEMPL.V_CLASS := "C" ;
ISNSIZEEMPL := INTEGER(CBEMPL.ISN_BUFFER_LENGTH / 4) ;
ISNINDEMPL := 1 ;
CBEMPL.ISN_LOWER_LIMIT := 0 ;
CBEMPL.COMMAND_OPTION_1 := " " ;
CBEMPL.COMMAND_OPTION_2 := " " ;
CBEMPL.ISN_QUANTITY := 0 ;
CBEMPL.ISN_BUFFER_LENGTH := 0 ;
CBEMPL.COMMAND_CODE := "S1" ;
AEMPL.ADABAS (
CBEMPL,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
ISN_BUFEMPL ) ;
EMPLOYEES.RESPONSE_CODE :=
CBEMPL.RESPONSE_CODE ;
EMPLOYEES.QUANTITY :=
CBEMPL.ISN_QUANTITY ;
EMPLOYEES.ISN :=
CBEMPL.ISN ;
if CBEMPL.RESPONSE_CODE /= 0
then
CSEQ := "00000000" ;
CLN1(01) := " EXEC ADABAS " ;
CLN2(01) := " " ;
CLN1(02) := " OPEN EMPL " ;
CLN2(02) := " " ;
CLN1(03) := " END-EXEC " ;
CLN2(03) := " " ;
CLNNUM := 03 ;
AEMPL.RESPF
(CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
CLN1,CLN2,TRCE,CLNNUM) ;
end if ;
ISNMOREEMPL := CBEMPL.ISN_QUANTITY ;
if ISNMOREEMPL > 0 then
EOFEMPL := FALSE ;
else
EOFEMPL := TRUE ;
end if ;
if ISNMOREEMPL < ISNSIZEEMPL then
ISNSIZEEMPL := ISNMOREEMPL ;
end if ;
ISNINDEMPL :=0 ;
PUT_LINE (HEADER) ;
PUT_LINE (HEADER2) ;
PUT_LINE (SPACE_LINE) ;
--
-- EXEC ADABAS
-- FETCH EMPL
-- END-EXEC
--
if ISNINDEMPL = ISNMOREEMPL then
EOFEMPL := TRUE ;
end if ;
if not(EOFEMPL) then
EOFEMPL := FALSE ;
CBEMPL.COMMAND_OPTION_2 := "N" ;
CBEMPL.COMMAND_OPTION_1 := " " ;
CBEMPL.COMMAND_CODE := "L1" ;
AEMPL.ADABAS (
CBEMPL,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
ISN_BUFEMPL ) ;
EMPLOYEES.RESPONSE_CODE :=
CBEMPL.RESPONSE_CODE ;
EMPLOYEES.QUANTITY :=
CBEMPL.ISN_QUANTITY ;
EMPLOYEES.ISN :=
CBEMPL.ISN ;
if CBEMPL.RESPONSE_CODE = 3 then
EOFEMPL := TRUE ;
else
if CBEMPL.RESPONSE_CODE /= 0
then
CSEQ := "00000000" ;
CLN1(01) := " EXEC ADABAS " ;
CLN2(01) := " " ;
CLN1(02) := " FETCH EMPL " ;
CLN2(02) := " " ;
CLN1(03) := " END-EXEC " ;
CLN2(03) := " " ;
CLNNUM := 03 ;
AEMPL.RESPF
(CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
CLN1,CLN2,TRCE,CLNNUM) ;
end if ;
end if ;
end if ;
if EOFEMPL then
ADACODE := 003 ;
else
ADACODE := 0 ;
end if ;
while ADACODE /= 3 loop
PUT_LINE (" " & EMPLOYEES.PERSONNEL_ID & " " & EMPLOYEES.NAME &
" " & EMPLOYEES.FIRST_NAME & " " & EMPLOYEES.BIRTH & " "
& EMPLOYEES.SEX ) ;
--
-- EXEC ADABAS
-- FETCH EMPL
-- END-EXEC
--
if ISNINDEMPL = ISNMOREEMPL then
EOFEMPL := TRUE ;
end if ;
if not(EOFEMPL) then
EOFEMPL := FALSE ;
CBEMPL.COMMAND_OPTION_2 := "N" ;
CBEMPL.COMMAND_OPTION_1 := " " ;
CBEMPL.COMMAND_CODE := "L1" ;
AEMPL.ADABAS (
CBEMPL,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
ISN_BUFEMPL ) ;
EMPLOYEES.RESPONSE_CODE :=
CBEMPL.RESPONSE_CODE ;
EMPLOYEES.QUANTITY :=
CBEMPL.ISN_QUANTITY ;
EMPLOYEES.ISN :=
CBEMPL.ISN ;
if CBEMPL.RESPONSE_CODE = 3 then
EOFEMPL := TRUE ;
else
if CBEMPL.RESPONSE_CODE /= 0
then
CSEQ := "00000000" ;
CLN1(01) := " EXEC ADABAS " ;
CLN2(01) := " " ;
CLN1(02) := " FETCH EMPL " ;
CLN2(02) := " " ;
CLN1(03) := " END-EXEC " ;
CLN2(03) := " " ;
CLNNUM := 03 ;
AEMPL.RESPF
(CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
CLN1,CLN2,TRCE,CLNNUM) ;
end if ;
end if ;
end if ;
if EOFEMPL then
ADACODE := 003 ;
else
ADACODE := 0 ;
end if ;
end loop ;
--
-- EXEC ADABAS
-- CLOSE EMPL
-- END-EXEC
--
CBEMPL.COMMAND_OPTION_1 := "I" ;
CBEMPL.COMMAND_OPTION_2 := "S" ;
CBEMPL.COMMAND_CODE := "RC" ;
AEMPL.ADABAS (
CBEMPL,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
ISN_BUFEMPL ) ;
EMPLOYEES.RESPONSE_CODE :=
CBEMPL.RESPONSE_CODE ;
EMPLOYEES.QUANTITY :=
CBEMPL.ISN_QUANTITY ;
EMPLOYEES.ISN :=
CBEMPL.ISN ;
if CBEMPL.RESPONSE_CODE /= 0
then
CSEQ := "00000000" ;
CLN1(01) := " EXEC ADABAS " ;
CLN2(01) := " " ;
CLN1(02) := " CLOSE EMPL " ;
CLN2(02) := " " ;
CLN1(03) := " END-EXEC " ;
CLN2(03) := " " ;
CLNNUM := 03 ;
AEMPL.RESPF
(CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
EMPLOYEES ,SEARCH_BUFEMPL,VBEMPL,
CLN1,CLN2,TRCE,CLNNUM) ;
end if ;
--
-- EXEC ADABAS
-- DBCLOSE
-- END-EXEC
--
CB_OPN.RECORD_BUFFER_LENGTH := 1500 ;
CB_OPN.COMMAND_OPTION_2 := " " ;
CB_OPN.COMMAND_CODE := "CL" ;
A_OPN.ADABAS (
CB_OPN,FORMAT_BUF_OPN,
RB_OPN ,SEARCH_BUF_OPN,VB_OPN,
ISN_BUF_OPN ) ;
if CB_OPN.RESPONSE_CODE /= 0
then
CSEQ := "00000000" ;
CLN1(01) := " EXEC ADABAS " ;
CLN2(01) := " " ;
CLN1(02) := " DBCLOSE " ;
CLN2(02) := " " ;
CLN1(03) := " END-EXEC " ;
CLN2(03) := " " ;
CLNNUM := 03 ;
A_OPN.RESPF
(CB_OPN,DDFILE,CSEQ,FORMAT_BUF_OPN,
RB_OPN ,SEARCH_BUF_OPN,VB_OPN,
CLN1,CLN2,TRCE,CLNNUM) ;
end if ;
end AEX1 ;
