Make your own free website on Tripod.com

File : oci-thick.adb


with
   Ada.Exceptions,
   System,
   OCI.Thread;
--with Text_IO,System.Address_Image; use Text_IO,System;
package body Oci.Thick is
   use Lib;
   use type Sword;
   use type Ub4;
   use type OCIHandle;
   use Ada.Exceptions;
   
-- Local utilities

   procedure Check_Error(
         Code : Sword;
         Handle : OCIHandle;
         Htype : Integer)
         is
      Errcodep : aliased Sb4 := 0;
      Bufp : aliased C.Char_Array := (0..512=> C.nul);
      Rc : Sword;
   begin
      case Code is
         when OCI_ERROR  => Rc := OCIErrorGet(Hndlp => Handle,
               Errcodep => Errcodep'access,
               Bufp => CStr.To_Chars_Ptr(Bufp'Unchecked_Access),
               Bufsiz => Bufp'Length-1,
               Htype => UB4(Htype));
            if Rc=OCI_SUCCESS then
               Raise_Exception(LIB_ERROR'Identity,C.To_Ada(Bufp));
            else
               Raise_Exception(LIB_ERROR'Identity,
                  "Error code:"&Sword'Image(Code)&Ascii.Lf&
                  "Return error code:"&Sword'Image(Rc)&Ascii.Lf&
                  "Output error code:"&Sb4'Image(Errcodep));
            end if;
         when OCI_INVALID_HANDLE => raise INVALID_HANDLE;
         --Later     when OCI_SUCCESS => null;
         when others => null;
      end case;
   end Check_Error;

   procedure Check_Error(
         Code : Sword) is
   begin
      Check_Error(Code,OCIHandle(Thread.Error),
         OCI_HTYPE_ERROR);
   end Check_Error;

   function Alloc_Handle(Parent : OCIEnv; Htype : Ub4) return OCIHandle
         is
      Result : aliased OCIHandle := Empty_Handle;
      Rc : Sword := OCIHandleAlloc(Parenth => OCIHandle(Parent),
         Hndlpp => Result'access,
         Htype => Htype);
   begin
      if Rc/=OCI_SUCCESS then
         raise INVALID_HANDLE;
      end if;
      return Result;
   end;

   procedure Free(H : OCIHandle; HType : Ub4) is
      Rc : Sword;
   begin
      if H=Empty_Handle then
         return;
      end if;
      RC := OCIHandleFree(H, HType);
      if Rc/=OCI_SUCCESS then
        raise INVALID_HANDLE;
      end if;
   end Free;

-- Base_Variable
   
   procedure Clear_Value(Var : in out Base_Variable'Class) is
   begin
      Var.Indicator := Null_Indicator;
   end;

   function Is_Null(Var : Base_Variable'Class) return Boolean is
      use type Sb2;
   begin
      if Var.Define=OCIDefine(Empty_Handle)
            and Var.Bind=OCIBind(Empty_Handle) then
         raise NOT_ATTACHED;
      end if;
      return Var.Indicator = Null_Indicator;
   end;

-- OCIDate

   function To_String(From : OCIDate; Format : String) return String
         is
      Buff : aliased Text := (0..C."+"(Format'Length,64)=> C.nul);
      Len : aliased Ub4 := Buff'Length-1;
      Rc : Sword := OCIDateToText (
         Err => Thread.Error,
         Date => From,
         Fmt => C.To_C(Format),
         Fmt_Length => Format'Length,
         Lang_Name => 0,
         Lang_Length => 0,
         Buf_Size => Len'access,
         Buf => CStr.To_Chars_Ptr(Buff'Unchecked_Access));
   begin
      Check_Error(Rc);
      return C.To_Ada(Buff,False)(1..Integer(Len));
   end To_String;

   function SysDate return OCIDate is
      Result : aliased OCIDate;
      Rc :  Sword := OCIDateSysDate (Err => Thread.Error
         ,
         Date => Result'access);
   begin
      Check_Error(Rc);
      return Result;
   end SysDate;

   function Handle(ref : Handle_REference'Class) return OCIHandle is
   begin
     return ref.Handle;
   end;

 
end Oci.Thick