with String_Access_Class, Access_To_Array_Of_String_Access_Class, Accessed_Buffers, Unchecked_Deallocation, System; package body Dbms_Template is use Dbms_Errors; Dbms_Status : Dbms_Errors.Error_Kind; package Access_To_C_String_Array renames Access_To_Array_Of_String_Access_Class; type Create_Fields_Structure is record Count : Natural; The_Fields : Access_To_C_String_Array. Array_Of_String_Access_Access; The_Types : Access_To_C_String_Array. Array_Of_String_Access_Access; end record; procedure Free is new Unchecked_Deallocation (Object => Create_Fields_Structure, Name => Create_Fields); procedure Replace (The_Character : in Character; With_The_Character : in Character; In_The_String : in out String); ---------------------------------------------------- function Dbms_Init return Dbms_Errors.Error_Kind; function Dbms_Exit return Dbms_Errors.Error_Kind; pragma INTERFACE (C, Dbms_Init); pragma INTERFACE (C, Dbms_Exit); pragma INTERFACE_NAME (Dbms_Init, "_px_init"); pragma INTERFACE_NAME (Dbms_Exit, "_px_exit"); procedure Impart is begin Dbms_Status := Dbms_Init; if Dbms_Status /= Successful then raise Dbms_Error; end if; end Impart; procedure Depart is begin Dbms_Status := Dbms_Exit; if Dbms_Status /= Successful then raise Dbms_Error; end if; end Depart; package body Create_Fields_Builder is function Is_Converted_Type (T : in Dbms_Declarations.Field_Kind ) return String is use Dbms_Declarations; begin begin case T.Kind is when Alphanumeric => declare Alpha_Size : constant String := Alphanumeric_Length'IMAGE (T.Length); begin return "A" & Alpha_Size (2 .. Alpha_Size'LENGTH); end; when Date => return "D"; when Real | Long => return "N"; when Currency => return "$"; when Short => return "S"; end case; exception when Storage_Error => raise Operation_Failure; end; end Is_Converted_Type; procedure Initialize (Fields : out Create_Fields; Number_Of_Fields : in Dbms_Declarations.Dbms_Field_Count) is begin Fields := new Create_Fields_Structure' (Count => 0, The_Fields | The_Types => new Access_To_C_String_Array. Array_Of_String_Access (1 .. Positive (Number_Of_Fields))); exception when Storage_Error => raise Operation_Failure; end Initialize; procedure Set (Table_Fields : in out Create_Fields; To_Field_Name : in String; To_Field_Type : in Dbms_Declarations.Field_Kind) is Count : Natural renames Table_Fields.Count; begin Count := Count + 1; Table_Fields.The_Fields (Count) := new String'(To_Field_Name & Ascii.Nul); Table_Fields.The_Types (Count) := new String'(Is_Converted_Type (To_Field_Type) & Ascii.Nul ); exception when Constraint_Error => Count := Count - 1; raise Size_Error; end Set; procedure Dispose_Of (Fields : in out Create_Fields) is begin Access_To_C_String_Array.Free (Fields.The_Fields); Access_To_C_String_Array.Free (Fields.The_Types); Free (Fields); end Dispose_Of; end Create_Fields_Builder; function Is_Error return Dbms_Errors.Error_Kind is begin return Dbms_Status; end Is_Error; procedure Replace (The_Character : in Character; With_The_Character : in Character; In_The_String : in out String) is begin for This_Character in In_The_String'RANGE loop if In_The_String (This_Character) = The_Character then In_The_String (This_Character) := With_The_Character; end if; end loop; end Replace; package body Table_Operations is separate; package body Record_Operations is separate; package body Field_Operations is separate; package body Index_Operations is separate; package body Search_Operations is separate; end Dbms_Template;