with linked_list; with generator_support; use generator_support; with string_pack; use string_pack; with variable_io; with text_io; use text_io; procedure rdb_specific is concrete_body : file_type; concrete_spec1, concrete_spec2 : file_type; old_concrete_spec : file_type; specific_info : file_type; type param_info is record proc_name : string(1..100) := (others => ' '); param_name : string (1..100) := (others => ' '); param_mode : string (1..6) := (others => ' '); param_type : string (1..100) := (others => ' '); param_length : integer := 0; end record; parm_packet : param_info; package body_io is new variable_io(80); package spec_io is new variable_io(80); package params is new linked_list(param_info); package used_lengths is new linked_list(integer); use used_lengths; use params; parm_list : params.list; used_lengths_list : used_lengths.list; last : natural; finished, already_declared : boolean := false; temp_proc_name, actual_concrete_spec, concrete_name, before, line_from_file, temp_line_from_file, orig_conc, dbms_specific : string(1..100) := (others => ' '); the_decl, the_call : string(1..500) := (others => ' '); real_mode : string (1..8) := (others => ' '); more : string (1..10) := "n "; first_time_thru, more_abstract_interfaces : boolean := true; --******************************************************************************************** procedure split_string(the_line, first_part : in out string; split_at : character := ' ') is temp : string (1..the_line'length) := (others => ' '); begin first_part := (others => ' '); for i in 1..strip(the_line)'length loop if the_line(i) = split_at then move (strip(the_line(i+1..the_line'last)), temp); move (the_line(1..i-1), first_part); move (temp, the_line); exit; end if; if i = strip(the_line)'length then move (the_line(1..i), first_part); move ("", the_line); end if; end loop; end split_string; --******************************************************************************************** begin while more_abstract_interfaces loop text_io.put_line("Input name of file containing original concrete_spec => "); orig_conc := (others => ' '); get_line(orig_conc, last); open(old_concrete_spec, in_file, strip(orig_conc)); get_line(old_concrete_spec, line_from_file, last); get_line(old_concrete_spec, line_from_file, last); line_from_file := (others => ' '); get_line(old_concrete_spec, line_from_file, last); close (old_concrete_spec); split_string(line_from_file, concrete_name); split_string(line_from_file, concrete_name); -- concrete_name now holds the name of the current concrete spec -- first create the spec that will replace the current concrete spec...it will -- be named the same and look exactly the same without the pragmas. create(concrete_spec1, name => strip(concrete_name) & spec_extension); open(old_concrete_spec, in_file, strip(orig_conc) & ";1"); line_from_file := (others => ' '); get_line(old_concrete_spec, line_from_file, last); loop move (line_from_file, temp_line_from_file); split_string(temp_line_from_file, before); if strip(before) /= "pragma" then spec_io.put_line(concrete_spec1, strip(line_from_file)); else spec_io.put_line(concrete_spec1, " "); -- puts a blank line between procedures end if; exit when end_of_file(old_concrete_spec); line_from_file := (others => ' '); get_line(old_concrete_spec, line_from_file, last); end loop; close (old_concrete_spec); close (concrete_spec1); -- next read in the dbms specific information to use while editting the body of the 'old' spec -- and the real concrete spec to be used text_io.put_line("Input name of file containing dbms specific information => "); dbms_specific := (others => ' '); get_line(dbms_specific, last); open(specific_info,in_file, strip(dbms_specific)); -- this opens the file with dbms specific information line_from_file := (others => ' '); get_line(specific_info, line_from_file, last); -- the following loop builds up a linked list containing information about -- all procedure parameters in the old concrete spec loop split_string(line_from_file, before); -- on return before holds proc name move(strip(before),parm_packet.proc_name); split_string(line_from_file, before); -- on return before holds param_name move(strip(before), parm_packet.param_name); split_string(line_from_file, before); -- on return before holds param_mode move(strip(before), parm_packet.param_mode); split_string(line_from_file, before); -- on return before holds param_type move(strip(before), parm_packet.param_type); if strip(parm_packet.param_type) = "CHAR" then parm_packet.param_length := integer'value(strip(line_from_file)); -- line_from_file holds the -- integer length if there was one else parm_packet.param_length := 0; end if; params.add_member(parm_list, parm_packet); exit when end_of_file(specific_info); line_from_file := (others => ' '); get_line(specific_info, line_from_file, last); end loop; close (specific_info); -- Next create the files that will contain -- 1) The spec with the pragma interfaces and rdb specific information -- 2) The body to go with the 'old'spec which will convert from SAME standard calls -- and types to RDB specific calls and types. if first_time_thru then text_io.put_line("Input the name of the actual concrete spec => "); get_line(actual_concrete_spec, last); create (concrete_spec2, out_file, strip(actual_concrete_spec) & spec_extension); end if; create (concrete_body, out_file, strip(concrete_name) & body_extension); -- next start editting the files .. put initial information into the body body_io.put_line(concrete_body, "with " & strip(actual_concrete_spec) & ";"); body_io.put_line(concrete_body, "use " & strip(actual_concrete_spec) & ";"); body_io.put_line(concrete_body, "package body " & strip(concrete_name) & " is"); body_io.put_line(concrete_body, " "); -- put initial information into the spec if first_time_thru then spec_io.put_line(concrete_spec2, "package " & strip(actual_concrete_spec) & " is"); spec_io.put_line(concrete_spec2, " "); end if; params.rewind (parm_list); params.current_member(parm_list, parm_packet, finished); finished := false; while not finished loop -- the following loop generates the string subtype -- declarations needed by RDB if strip(parm_packet.param_type) = "CHAR" then used_lengths.is_member(used_lengths_list, parm_packet.param_length, already_declared); if not already_declared then spec_io.put_line(concrete_spec2, indent1 & "subtype string" & strip(integer'image(parm_packet.param_length)) & " is string (1.." & strip(integer'image(parm_packet.param_length)) & ");"); used_lengths.add_member(used_lengths_list,parm_packet.param_length); end if; end if; params.next_member(parm_list, parm_packet, finished); end loop; spec_io.put_line(concrete_spec2, " "); -- complete the body first..then close and re-open spec to work on new spec -- must open newly created concrete spec to copy procedure information open(concrete_spec1, in_file, strip(concrete_name) & spec_extension); line_from_file := (others => ' '); -- clear buffer get_line(concrete_spec1, line_from_file, last); params.rewind(parm_list); params.current_member(parm_list, parm_packet, finished); loop move (line_from_file, temp_line_from_file); split_string(temp_line_from_file, before); if strip(before) = "procedure" then -- this is the beginning of a procedure declaration if line_from_file(strip(line_from_file)'length - 1 .. strip(line_from_file)'length) = ");" then -- this is only a one line declaration body_io.put_line(concrete_body, indent2 & line_from_file(1..strip(line_from_file)'length - 2) & ") is"); -- this leaves off the ");" and repalces it with ' is'. else -- this is not the only line of the procedure declaration..put them all body_io.put_line(concrete_body, indent2 & strip(line_from_file)); line_from_file := (others => ' '); get_line(concrete_spec1, line_from_file, last); while line_from_file(strip(line_from_file)'length - 1 .. strip(line_from_file)'length) /= ");" loop body_io.put_line(concrete_body, indent3 & strip(line_from_file)); line_from_file := (others => ' '); get_line(concrete_spec1, line_from_file, last); end loop; body_io.put_line(concrete_body, indent3 & line_from_file(1..strip(line_from_file)'length - 2) & ") is"); -- this leaves off the ");" and repalces is with ' is'. end if; body_io.put_line(concrete_body, indent2 & "begin"); -- following builds up the call to the new concrete interface which has the RDB specific information -- and the procedure declarations in the new concrete_spec move(strip(the_call) & indent3 & strip(actual_concrete_spec) & "." & strip(parm_packet.proc_name) & "(", the_call); move(strip(the_decl) & "procedure " & strip(parm_packet.proc_name) & "(", the_decl); move (parm_packet.proc_name, temp_proc_name); while strip(temp_proc_name) = strip(parm_packet.proc_name) and not finished loop if strip(parm_packet.param_mode) = "in" then move(" in ", real_mode); elsif strip(parm_packet.param_mode) = "out" then move (" out ", real_mode); else move (" in out ", real_mode); end if; if strip(parm_packet.param_type) = "CHAR" then -- must convert to the string subtype move(strip(the_call) & " string" & strip(integer'image(parm_packet.param_length)) & "(" & strip(parm_packet.param_name) & "),", the_call); move(strip(the_decl) & " " & strip(parm_packet.param_name) & " : " & strip(real_mode) & " string" & strip(integer'image(parm_packet.param_length)) & ";", the_decl); elsif strip(parm_packet.param_type) = "DOUBLE_PRECISION" or strip(parm_packet.param_type) = "REAL" then move(strip(the_call) & " float(" & strip(parm_packet.param_name) & "),", the_call); move(strip(the_decl) & " " & strip(parm_packet.param_name) & " : " & strip(real_mode) & " float;", the_decl); elsif strip(parm_packet.param_type) = "sqlcode_type" then move(strip(the_call) & "integer(sqlcode));", the_call); move(strip(the_decl) & " sqlcode : out integer);", the_decl); elsif strip(parm_packet.param_type) = "indicator_type" then move(strip(the_call) & "short_integer(" & strip(parm_packet.param_name) & "),", the_call); move(strip(the_decl) & " " & strip(parm_packet.param_name) & " : " & strip(real_mode) & " short_integer;", the_decl); else move(strip(the_call) & " integer(" & strip(parm_packet.param_name) & "),", the_call); move(strip(the_decl) & strip(parm_packet.param_name) & " : " & strip(real_mode) & " integer;", the_decl); end if; params.next_member(parm_list, parm_packet, finished); if strip(temp_proc_name) /= strip(parm_packet.proc_name) or finished then body_io.put_line(concrete_body, indent3 & strip(the_call)); spec_io.put_line(concrete_spec2, indent1 & strip(the_decl)); spec_io.put_line(concrete_spec2, indent1 & "pragma interface (sql, " & strip(temp_proc_name) & ");"); spec_io.put_line(concrete_spec2, " "); the_decl := (others => ' '); the_call := (others => ' '); end if; end loop; body_io.put_line(concrete_body, indent2 & "end;"); body_io.put_line(concrete_body, " "); exit when end_of_file(concrete_spec1); line_from_file := (others => ' '); get_line(concrete_spec1, line_from_file, last); else exit when end_of_file(concrete_spec1); line_from_file := (others => ' '); get_line(concrete_spec1, line_from_file, last); end if; first_time_thru := false; end loop; spec_io.put_line(concrete_spec2, " "); body_io.put_line(concrete_body, " "); body_io.put_line(concrete_body, "end " & strip(concrete_name) & ";"); close (concrete_spec1); close (concrete_body); make_empty(parm_list); text_io.put_line("Any more abstract specifications? Answer y or n => "); text_io.get_line(more, last); if strip(more) = "y" then more_abstract_interfaces := true; else more_abstract_interfaces := false; end if; end loop; spec_io.put_line(concrete_spec2, "end " & strip(actual_concrete_spec) & ";"); close (concrete_spec2); release(used_lengths_list); release(parm_list); end rdb_specific;