Make your own free website on Tripod.com

File : oci-thick-parameter_pkg.adb


with
   System,
   OCI.Thread;
--with Text_IO,System.Address_Image; use Text_IO,System;

package body OCI.Thick.Parameter_pkg is
   use Lib;
   use type Sword;
   use type Ub4;
   use type OCIHandle;

   procedure Free(Param : OCIParam) is
     rc : sword;
   begin
     if Param=OCIParam(Empty_Handle) then
       return;
     end if;
     rc := OCIDescriptorFree (
         descp => OCIHandle(Param),
         dtype => OCI_DTYPE_PARAM);
     Check_Error(rc);
--     Put_Line("PARAM freed");
   end Free;

   function Get_Param_Attr(Param : OCIParam; Attr : Ub4) return String
         is
      Buff : aliased Cstr.Chars_Ptr;
      Rsize : aliased Ub4;
      Rc : Sword := OCIAttrGet (Trgthndlp => OCIHandle(Param),
         Trghndltyp => OCI_DTYPE_PARAM,
         Attributep => Buff'access,
         Sizep => Rsize'access,
         Attrtype => Attr,
         Errhp => Thread.Error);
       
   begin
      Check_Error(Rc);
      if cstr."="(Buff,cstr.Null_Ptr) then
        return "";
      else
        return C.To_Ada(Cstr.Value(Buff,C.Size_T(Rsize)),False);
      end if;  
   end Get_Param_Attr;

   function Get_Param_Attr(Param : OCIParam; Attr : Ub4) return Integer
         is
      Result : aliased Integer := 0;
      Rsize : aliased Ub4;
      Rc : Sword := OCIAttrGet (Trgthndlp => OCIHandle(Param),
         Trghndltyp => OCI_DTYPE_PARAM,
         Attributep => Result'access,
         Sizep => Rsize'access,
         Attrtype => Attr,
         Errhp => Thread.Error);
   begin
      Check_Error(Rc);
      return Result;
   end Get_Param_Attr;

   Recode_Typecodes : array(1..OCI_TYPECODE_OTMLAST) of Typecode :=
      (
      OCI_TYPECODE_REF => TYPE_REF,
      OCI_TYPECODE_DATE       => TYPE_DATE      ,
      OCI_TYPECODE_SIGNED8    => TYPE_SIGNED8   ,
      OCI_TYPECODE_SIGNED16   => TYPE_SIGNED16  ,
      OCI_TYPECODE_SIGNED32   => TYPE_SIGNED32  ,
      OCI_TYPECODE_REAL       => TYPE_REAL      ,
      OCI_TYPECODE_DOUBLE     => TYPE_DOUBLE    ,
      OCI_TYPECODE_FLOAT      => TYPE_FLOAT     ,
      OCI_TYPECODE_NUMBER     => TYPE_NUMBER    ,
      OCI_TYPECODE_DECIMAL    => TYPE_DECIMAL   ,
      OCI_TYPECODE_UNSIGNED8  => TYPE_UNSIGNED8 ,
      OCI_TYPECODE_UNSIGNED16 => TYPE_UNSIGNED16 ,
      OCI_TYPECODE_UNSIGNED32 => TYPE_UNSIGNED32 ,
      OCI_TYPECODE_OCTET      => TYPE_OCTET     ,
      OCI_TYPECODE_SMALLINT   => TYPE_SMALLINT  ,
      OCI_TYPECODE_INTEGER    => TYPE_INTEGER   ,
      OCI_TYPECODE_RAW        => TYPE_RAW       ,
      OCI_TYPECODE_PTR        => TYPE_PTR       ,
      OCI_TYPECODE_VARCHAR2   => TYPE_VARCHAR2  ,
      OCI_TYPECODE_CHAR       => TYPE_CHAR      ,
      OCI_TYPECODE_VARCHAR    => TYPE_VARCHAR   ,
      OCI_TYPECODE_MLSLABEL  => TYPE_MLSLABEL ,
      OCI_TYPECODE_VARRAY   => TYPE_VARRAY   ,
      OCI_TYPECODE_TABLE     => TYPE_TABLE    ,
      OCI_TYPECODE_OBJECT     => TYPE_OBJECT   ,
      OCI_TYPECODE_OPAQUE      => TYPE_OPAQUE    ,
      OCI_TYPECODE_NAMEDCOLLECTION => TYPE_NAMEDCOLLECTION,
      OCI_TYPECODE_BLOB    => TYPE_BLOB   ,
      OCI_TYPECODE_BFILE  => TYPE_BFILE ,
      OCI_TYPECODE_CLOB  => TYPE_CLOB ,
      OCI_TYPECODE_CFILE => TYPE_CFILE,
      others=>Type_Undefined);

   procedure Destroy  (Object : in out Parameter) is
     H : OCIHandle := Object.Handle;
   begin
     Free(OCIParam(H));
   end;    

   function Type_Name(Param : Parameter) return String is
      H : OCIHandle := Param.Handle;
   begin
      if H=Empty_Handle then
         return "";
      else
         return Get_Param_Attr(OCIParam(H),OCI_ATTR_TYPE_NAME);
      end if;
   end Type_Name;

   function Name(Param : Parameter) return String is
      H : OCIHandle := Param.Handle;
   begin
      if H=Empty_Handle then
         return "";
      else
         return Get_Param_Attr(OCIParam(H),OCI_ATTR_NAME);
      end if;
   end Name;
 
   function Type_Code(Param : Parameter) return Typecode is
   begin
      return Recode_Typecodes(Get_Param_Attr(
         OCIParam(Param.Handle),OCI_ATTR_DATA_TYPE));
   end Type_Code;

   function Data_Size(Param : Parameter) return Natural is
   begin
      return Get_Param_Attr(OCIParam(Param.Handle),OCI_ATTR_DATA_SIZE);
   end;
   
   function PRECISION(Param : Parameter) return Integer is
   begin
     return Get_Param_Attr(OCIParam(Param.Handle),OCI_ATTR_PRECISION);
   end;

   function SCALE(Param : Parameter) return Integer is
   begin
     return Get_Param_Attr(OCIParam(Param.Handle),OCI_ATTR_SCALE);
   end;
   
   function IS_NULL(Param : Parameter) return Boolean is
   begin
     return Get_Param_Attr(OCIParam(Param.Handle),OCI_ATTR_IS_NULL)/=0;
   end;

   function SCHEMA_NAME(Param : Parameter) return String is
   begin
     return Get_Param_Attr(OCIParam(Param.Handle),OCI_ATTR_SCHEMA_NAME);
   end;

   function Get_Parameter(Stmt : Statement; Index : Positive) return
         OCIParam is
      Result : aliased OCIParam;
      Rc : Sword := OCIParamGet (
         Hndlp => Handle(Stmt),
         Htype => OCI_HTYPE_STMT,
         Errhp => Thread.Error,
         Parmdpp => Result'access,
         Pos => Ub4(Index));
   begin
      if Rc=OCI_NO_DATA then
         return OCIParam(Empty_Handle);
      end if;
      Check_Error(Rc);
      return Result;
   end;

   function Column(Stmt : Statement; Position : Positive) return Parameter
   is
   begin
     return (RF.Controlled_Reference with
       Handle => OCIHandle(Get_Parameter(Stmt,Position)),
       Last_Stmt => Stmt,
       Connect => Get_Connection(Stmt));
   end;

   function Get_Parameters(Stmt : Statement) return Parameters is
     Result : Parameters(1..Number_Of_Columns(Stmt));
   begin
     for i in Result'Range loop
        Result(i) := Column(Stmt,i);
     end loop;
     return Result;
   end Get_Parameters;

end OCI.Thick.Parameter_pkg;