* Started support of extended PQ types, starting with enum

git-svn-id: trunk@26766 -

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -31,6 +31,15 @@ type
   end;
 
   { TPQCursor }
+  TExtendedFieldType = (eftNone,eftEnum);
+  TFieldBinding = record
+    Index : Integer;
+    TypeOID : oid;
+    TypeName : String;
+    ExtendedFieldType: TExtendedFieldType;
+  end;
+  PFieldBinding = ^TFieldBinding;
+  TFieldBindings = Array of TFieldBinding;
 
   TPQCursor = Class(TSQLCursor)
   protected
@@ -39,7 +48,7 @@ type
     tr           : TPQTrans;
     res          : PPGresult;
     CurTuple     : integer;
-    FieldBinding : array of integer;
+    FieldBinding : TFieldBindings;
    Public
     Destructor Destroy; override;
   end;
@@ -71,9 +80,11 @@ type
     FVerboseErrors       : Boolean;
     procedure CheckConnectionStatus(var conn: PPGconn);
     procedure CheckResultError(var res: PPGresult; conn:PPGconn; ErrMsg: string);
-    function TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
+    function TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer; Out ATypeOID : oid) : TFieldType;
     procedure ExecuteDirectPG(const Query : String);
+    Procedure GetExtendedFieldInfo(cursor: TPQCursor; Bindings : TFieldBindings);
   protected
+    Function ErrorOnUnknownType : Boolean;
     // Add connection to pool.
     procedure AddConnection(T: TPQTranConnection);
     // Release connection in pool.
@@ -283,6 +294,59 @@ begin
 {$EndIf}
 end;
 
+procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor; Bindings: TFieldBindings);
+
+Var
+  tt,tc,Tn,S : String;
+  I,J : Integer;
+  Res : PPGResult;
+  toid : oid;
+  O : Array of integer;
+
+begin
+  SetLength(O,Length(Bindings));
+  For I:=0 to Length(Bindings)-1 do
+    if (Bindings[i].TypeOID>0) then
+      begin
+      if (S<>'') then
+        S:=S+', ';
+      S:=S+IntToStr(Bindings[i].TypeOID);
+      end;
+  if (S='') then
+    exit;
+  S:='select oid,typname,typtype,typcategory from pg_type where oid in ('+S+') order by oid';
+  Res:=PQExec(Cursor.tr.PGConn,PChar(S));
+  if (PQresultStatus(res)<>PGRES_TUPLES_OK) then
+    CheckResultError(Res,Cursor.tr.PGConn,'Error getting type info');
+  try
+    For I:=0 to PQntuples(Res)-1 do
+      begin
+      toid:=Strtoint(pqgetvalue(Res,i,0));
+      tn:=pqgetvalue(Res,i,1);
+      tt:=pqgetvalue(Res,i,2);
+      tc:=pqgetvalue(Res,i,3);
+      J:=length(Bindings)-1;
+      while (J>=0) and (Bindings[j].TypeOID<>toid) do
+        Dec(J);
+      if (J>=0) then
+        begin
+        Bindings[j].TypeName:=TN;
+        Case tt of
+          'e': // Enum
+            Bindings[j].ExtendedFieldType:=eftEnum;
+        end;
+        end;
+      end;
+  finally
+    PQClear(Res);
+  end;
+end;
+
+function TPQConnection.ErrorOnUnknownType: Boolean;
+begin
+  Result:=False;
+end;
+
 procedure TPQConnection.AddConnection(T: TPQTranConnection);
 
 begin
@@ -592,12 +656,20 @@ begin
     end;
 end;
 
-function TPQConnection.TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
-const VARHDRSZ=sizeof(longint);
-var li : longint;
+function TPQConnection.TranslateFldType(res: PPGresult; Tuple: integer; out
+  Size: integer; out ATypeOID: oid): TFieldType;
+
+const
+  VARHDRSZ=sizeof(longint);
+var
+  li : longint;
+  aoid : oid;
+
 begin
   Size := 0;
-  case PQftype(res,Tuple) of
+  ATypeOID:=0;
+  AOID:=PQftype(res,Tuple);
+  case AOID of
     Oid_varchar,Oid_bpchar,
     Oid_name               : begin
                              Result := ftstring;
@@ -661,7 +733,8 @@ begin
                              end;
     Oid_Unknown            : Result := ftUnknown;
   else
-    Result := ftUnknown;
+    Result:=ftUnknown;
+    ATypeOID:=AOID;
   end;
 end;
 
@@ -913,22 +986,58 @@ procedure TPQConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs)
 var
   i         : integer;
   size      : integer;
+  eft       : TExtendedFieldType;
+  aoid       : oid;
   fieldtype : tfieldtype;
   nFields   : integer;
+  b : Boolean;
+  Q : TPQCursor;
+  FD : TFieldDef;
+  FB : PFieldBinding;
 
 begin
-  with cursor as TPQCursor do
+  B:=False;
+  Q:=cursor as TPQCursor;
+  with Q do
     begin
     nFields := PQnfields(Res);
     setlength(FieldBinding,nFields);
     for i := 0 to nFields-1 do
       begin
-      fieldtype := TranslateFldType(Res, i,size);
+      fieldtype := TranslateFldType(Res, i,size, aoid );
       with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(PQfname(Res, i)), fieldtype,size, False, (i + 1)) do
-        FieldBinding[FieldNo-1] := i;
+        begin
+        FieldBinding[FieldNo-1].Index := i;
+        FieldBinding[FieldNo-1].TypeOID:=aOID;
+        B:=B or (aOID>0);
+        end;
       end;
     CurTuple := -1;
     end;
+  if B then
+    begin
+    // get all information in 1 go.
+    GetExtendedFieldInfo(Q,Q.FieldBinding);
+    For I:=0 to Length(Q.FieldBinding)-1 do
+      begin
+      FB:[email protected][i];
+      if (FB^.TypeOID>0) then
+        begin
+        FD:=FieldDefs[FB^.Index];
+        Case FB^.ExtendedFieldType of
+          eftEnum :
+            begin
+            FD.DataType:=ftString;
+            FD.Size:=64;
+            FD.Attributes:=FD.Attributes+[faReadonly];
+            end
+        else
+          if ErrorOnUnknownType then
+            DatabaseError('unhandled field type :'+FB^.TypeName,Self);
+        end;
+        end;
+      end;
+    end;
 end;
 
 function TPQConnection.GetHandle: pointer;
@@ -969,6 +1078,7 @@ begin
   result:=T.FPGConn;
 end;
 
+
 function TPQConnection.Fetch(cursor : TSQLCursor) : boolean;
 
 begin
@@ -1023,7 +1133,7 @@ begin
   Createblob := False;
   with cursor as TPQCursor do
     begin
-    x := FieldBinding[FieldDef.FieldNo-1];
+    x := FieldBinding[FieldDef.FieldNo-1].Index;
 
     // Joost, 5 jan 2006: I disabled the following, since it's useful for
     // debugging, but it also slows things down. In principle things can only go
@@ -1300,7 +1410,7 @@ var
 begin
   with cursor as TPQCursor do
     begin
-    x := FieldBinding[FieldDef.FieldNo-1];
+    x := FieldBinding[FieldDef.FieldNo-1].Index;
     li := pqgetlength(res,curtuple,x);
     ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer,li);
     Move(pqgetvalue(res,CurTuple,x)^, ABlobBuf^.BlobBuffer^.Buffer^, li);