unit upgsql;

interface

uses
  uDBConBase,
  {$IFDEF WINDOWS}
  postgres3dyn,
  {$ELSE}
  postgres,
  {$ENDIF}
  ufechas,
  Classes,
  xmatdefs,
  ufields,
  SysUtils;

type
  { TPgSqlRes }
  TPgSqlRes = class(IDataset)
    res: PPGresult;
  private
    kRec_: integer;
    field_lst: TList;

  public
    constructor Create(xres: PPGresult);
    procedure Free; virtual;
    function Estado: TExecStatusType;
    function nFields: integer;
    function FieldCount: integer;

    function FieldName(kfield: integer): string;
    function FieldType(kfield: integer): string;
    function kOfField(nombre: string): integer;

    function GetValue(krow, kfield: integer): string;

    // funciones para lectura por nombre.
    function GetI(krow: integer; nombre: string; defval: Integer = 0): integer;
    function GetF(krow: integer; nombre: string; defval: Double = 0.0): double;
    function GetS(krow: integer; nombre: string; defval: String = ''): string;
    function GetDT(krow: integer; nombre: string; defval: TDateTime = 0): TDateTime;

    function GetFieldVal(i: integer): string;
    function GetFieldValByName(nombre: string): string;

    procedure GetValByName( krow: integer; nombre: string; var valor: integer ); overload;
    procedure GetValByName( krow: integer; nombre: string; var valor: double ); overload;
    procedure GetValByName( krow: integer; nombre: string; var valor: string ); overload;
    function GetValByName( krow: integer; nombre: string): string; overload;
    procedure GetValByName( krow: integer; nombre: string; var valor: TDateTime ); overload;

    function FieldByName( nombre: string ): TField;

    procedure next;
    function EOF: boolean;
    procedure First;
    procedure Go(kRec: integer);


    function GetnRows: integer;
    function GetnFields: integer;

    function testOk: boolean;
    {---- investigando ---}
    function cmdStatus: string; //ultimo comando
    function oidStatus: string; //???

    function GetField( i: integer ): TField;

    property fields[i: integer]: TField Read GetField;

    property nRows: Integer read GetnRows;
  end;

  TSQLQuery = TPgSqlRes;

  { TPgSqlConn }

  TPgSqlConn = class
  private
    conn: PPGConn;
    function estado: TConnStatusType;

  public
    AutoRiseException: boolean;
    constructor Create(pghost, pgport,  // 5432  en vasen 5431
      pgoptions, // nil special options to start up the backend server
      pgtty, // nil  debugging tty for the backend server
      dbName, // base de dato
      usuario, // nobre del usuario
      clave: string); // clave
    procedure Free; virtual;
    function now(): TDateTime;
    function exec(const sqlstr: string): integer;
    function query(const sqlstr: string): TSQLQuery;

    function func( const sqlstr: string; defval: string = '' ): string;
    function funcI( const sqlstr: string; defval: integer = -1 ): integer;
    function funcF( const sqlstr: string; defval: double = -1 ): double;
    function funcS( const sqlstr: string; defval: string = '' ): string;
    function funcD( const sqlstr: string; defval: TDateTime = 0.0 ): TDateTime;
    function nextval(const tabla: string; campo: string='nid'; auto_crear: Boolean= false): integer;

    function testOk: boolean;
    function UltimoError: string;
  end;

  TPQConnection = TPgSqlConn;

implementation

function Occurs( const SubText: string; const Text: string ): Integer;
begin
  Result := Pos(SubText, Text);
  if Result > 0 then
    Result := (Length(Text) - Length(StringReplace(Text, SubText, '', [rfReplaceAll]))) div Length(subtext);
end;


function Split(const str: string; const separator: string): TDAofString;
var
  i, n: integer;
  strline, strfield: string;
begin
  n:= Occurs(separator, str);
  SetLength(Result, n + 1);
  i := 0;
  strline:= str;
  repeat
    if Pos(separator, strline) > 0 then
    begin
      strfield:= Copy(strline, 1, Pos(separator, strline) - 1);
      strline:= Copy(strline, Pos(separator, strline) + Length(separator) + 1, Length(strline) - pos(separator,strline));
    end
    else
    begin
      strfield:= strline;
      strline:= '';
    end;
    Result[i]:= strfield;
    Inc(i);
  until strline= '';

  if Result[High(Result)] = '' then
    SetLength(Result, Length(Result) -1);
end;

constructor TPgSqlConn.Create(pghost,  // zorrillo.sv.com.uy
  pgport,  // 5432  en vasen 5431
  pgoptions, // nil special options to start up the backend server
  pgtty, // nil  debugging tty for the backend server
  dbName, // base de dato
  usuario, // nobre del usuario
  clave: string); // clave
begin
  inherited Create;
  AutoRiseException := False;
  pghost := pghost + #0;
  pgport := pgport + #0;
  pgoptions := pgoptions + #0;
  pgtty := pgtty + #0;
  dbName := dbName + #0;
  usuario := usuario + #0;
  clave := clave + #0;

  conn := PQsetdbLogin(@pghost[1], @pgport[1], @pgoptions[1], @pgtty[1], @dbName[1], @usuario[1], @clave[1]);

end;

function TPgSqlConn.estado: TConnStatusType;
begin
  Result := PQstatus(conn);
end;

function TPgSqlConn.testOk: boolean;
begin
  Result := PQstatus(conn) = CONNECTION_OK;
end;


procedure TPgSqlConn.Free;
begin
  PQfinish(conn);
  inherited free;
end;

function TPgSqlConn.now(): TDateTime;
var
  ds: TSQLQuery;
  f: TField;
begin
  ds:= self.query('SELECT NOW();');
  f:= ds.fields[0];
  Result:= f.AsDateTime();
  f.Free();
  ds.Free();
end;

function TPgSqlConn.UltimoError: string;
var
  s: string;
begin
  s := PQerrorMessage(conn);
  Result := s;
end;


function TPgSqlConn.exec(const sqlstr: string): integer;
var
  respg: TPgSqlRes;
begin
  respg := query( sqlstr );

  //  ***  PG Doc ***
  //
  //  PQcmdTuples:
  //
  //  This function returns a string containing the number of rows affected by
  //  the SQL statement that generated the PGresult.
  //  This function can only be used following the execution of a
  //  SELECT, CREATE TABLE AS, INSERT, UPDATE, DELETE, MOVE, FETCH, or
  //  COPY statement, or an EXECUTE of a prepared query that contains an INSERT,
  //  UPDATE, or DELETE statement.
  //  If the command that generated the PGresult was anything else,
  //  PQcmdTuples returns an empty string. The caller should not free the return
  //  value directly. It will be freed when the associated PGresult handle
  //  is passed to PQclear.

  if PQcmdTuples(respg.res)<>'' then
    result:=  StrToInt( PQcmdTuples(respg.res) )
  else
    Result:=0;
  //result:= respg.GetnRows;
  respg.Free;
end;

function TPgSqlConn.query(const sqlstr: string): TSQLQuery;
var
  s: string;
  res: PPGresult;
  pgres: TPgSqlRes;
begin
  s := sqlstr + #0;
  res := PQexec(conn, @s[1]);
  pgres := TPgSqlRes.Create(res);
  if AutoRiseException then
    case pgres.Estado of
      PGRES_BAD_RESPONSE: raise Exception.Create('BAD_RESPONSE sqlexec: ' + UltimoError);
      PGRES_NONFATAL_ERROR: raise Exception.Create('NONFATAL_ERROR sqlexec: ' + UltimoError);
      PGRES_FATAL_ERROR: raise Exception.Create('FATAL_ERROR sqlexec: ' + UltimoError);
    end;
  result:= pgres;
end;

function TPgSqlConn.func( const sqlstr: string; defval: string = '' ): string;
var
  res: TPgSqlRes;
  s: string;
begin
  res:= query( sqlstr );
  if (res = nil) or (res.GetnRows <> 1) or (res.nFields <> 1 ) then
     s:= defval
  else
     s:= res.GetValue(0,0);
  result:= s;
  res.Free;
end;

function TPgSqlConn.funcI( const sqlstr: string; defval: integer = -1 ): integer;
var
  s: string;
begin
  s:= func( sqlstr, IntToStr( defval ) );
  result:= StrToInt( s );
end;

function TPgSqlConn.funcF( const sqlstr: string; defval: double = -1 ): double;
var
  s: string;
begin
  s:= func( sqlstr, FloatToStr( defval ) );
  result:= StrToFloat( s );
end;

function TPgSqlConn.funcS( const sqlstr: string; defval: string = '' ): string;
begin
  result:= func( sqlstr, defval );
end;

function TPgSqlConn.funcD( const sqlstr: string; defval: TDateTime = 0.0 ): TDateTime;
var
  s: string;
begin
  s:= func( sqlstr, FormatDateTime( 'yyyy-mm-dd hh:nn:ss',  defval ) );
  result:= StrToFloat( s );
end;


function TPgSqlConn.nextval(const tabla: string; campo: string = 'nid'; auto_crear: boolean = false ): integer;
var
  s: string;
begin
  s:= func( 'SELECT nextval( '''+tabla + '_' + campo + '_seq'+''' );' );
  if (s = '') and auto_crear then
  begin
    exec( 'CREATE SEQUENCE '+tabla + '_' + campo + '_seq'+' START 1;' );
    s:= func( 'SELECT nextval( '''+tabla + '_' + campo + '_seq'+''' );' );
  end;
  if s = '' then
    raise Exception.Create( 'Falló nextva en secuencia: '+ tabla + '_' + campo + '_seq' );
  result:= StrToInt( s );
end;


constructor TPgSqlRes.Create(xres: PPGresult);
begin
  inherited Create;
  res := xres;
  kRec_:= 0;
  if kRec_ >= GetnRows then
    kRec_:= -1;

  field_lst:=TList.Create;
end;


function TPgSqlRes.FieldByName( nombre: string ): TField;
//var
//  s: ansistring;
begin
  //GetValByName( kRec, nombre, s );
  //result:= TField.Create(  s );
  //SetLength(s,0);

  Result:= TField.Create( GetValByName(kRec_, nombre) );
  field_lst.Add(Result);

end;


function TPgSqlRes.GetField( i: integer ): TField;
begin
  result:= TField.Create( GetValue(kRec_,  i ) );
  field_lst.Add(Result);
end;



procedure TPgSqlRes.next;
var
  i: Integer;
begin
  inc( kRec_ );
  if kRec_ >= GetnRows then
    kRec_:= -1;
  //result:= kRec;

  for i:=0 to field_lst.Count-1 do
    TField(field_lst[i]).Free;
  field_lst.Clear;

end;

function TPgSqlRes.EOF: boolean;
begin
  result:= (kRec_ < 0) or (GetnRows=0);
end;

procedure TPgSqlRes.First;
var
  i: Integer;
begin
  kRec_:= 0;

  for i:=0 to field_lst.Count-1 do
    TField(field_lst[i]).Free;
  field_lst.Clear;

end;

procedure TPgSqlRes.Go(kRec: integer);
begin
  if kRec<GetnRows then
    self.kRec_:=kRec
  else
     Self.kRec_:=-1;
end;

procedure TPgSqlRes.Free;
var
  i: Integer;
begin
  PQclear(res);
  for i:=0 to field_lst.Count-1 do
    TField(field_lst[i]).Free;

  field_lst.Free;
  inherited Free;
end;

function TPgSqlRes.Estado: TExecStatusType;
begin
  Result := PQresultStatus(res);
end;

function TPgSqlRes.nFields: integer;
begin
  Result := PQnfields(res);
end;

function TPgSqlRes.FieldCount: integer;
begin
  result:= nFields;
end;

function TPgSqlRes.FieldName(kfield: integer): string;
begin
  Result := PQfname(res, kfield);
end;

function TPgSqlRes.FieldType(kfield: integer): string;
begin
  Result := IntToStr( PQftype(res, kfield));
end;


function TPgSqlRes.GetValue(krow, kfield: integer): string;
begin
  Result := PQgetvalue(res, krow, kfield);
end;

function TPgSqlRes.GetnFields: integer;
var
  resx: longint;
begin
  resx:=  PQnfields(res);
  result:= resx;
end;


function TPgSqlRes.GetnRows: integer;
var
  resx: longint;
begin
  resx:=  PQntuples(res);
  result:= resx;
end;

function TPgSqlRes.kOfField(nombre: string): integer;
begin
  nombre := nombre + #0;
  Result := PQfnumber(res, @nombre[1]);
end;


// funciones para lectura por nombre.
function TPgSqlRes.GetI(krow: integer; nombre: string; defval: Integer
  ): integer;
var
  s: string;
begin
  s := GetValue(krow, kOfField(nombre));
  if s = '' then
    Result := 0
  else
    Result := StrToInt(s);
end;

function TPgSqlRes.GetF(krow: integer; nombre: string; defval: Double): double;
var
  s: string;
begin
  s := GetValue(krow, kOfField(nombre));
  if s = '' then
    Result := 0
  else
    Result := StrToFloat(s);
end;

function TPgSqlRes.GetS(krow: integer; nombre: string; defval: String): string;
begin
  Result := GetValue(krow, kOfField(nombre));
end;

function TPgSqlRes.GetDT(krow: integer; nombre: string; defval: TDateTime
  ): TDateTime;
var
  s: string;
begin
  s := GetValue(krow, kOfField(nombre));
  if s = '' then
    Result := 0
  else
    Result:= IsoStrToDateTime(s);
//    Result := StrToDateTime(s);
end;

function TPgSqlRes.GetFieldVal(i: integer): string;
begin

end;

function TPgSqlRes.GetFieldValByName(nombre: string): string;
begin

end;


procedure TPgSqlRes.GetValByName( krow: integer; nombre: string; var valor: integer );
begin
  valor:= GetI( krow, nombre );
end;

procedure TPgSqlRes.GetValByName( krow: integer; nombre: string; var valor: double );
begin
  valor:= GetF( krow, nombre );
end;

procedure TPgSqlRes.GetValByName( krow: integer; nombre: string; var valor: string );
begin
  valor:= GetS( krow, nombre );
end;

function TPgSqlRes.GetValByName(krow: integer; nombre: string): string;
begin
  result:= GetS( krow, nombre );
end;

procedure TPgSqlRes.GetValByName( krow: integer; nombre: string; var valor: TDateTime );
begin
  valor:= GetDt( krow, nombre );
end;

function TPgSqlRes.testOk: boolean;
var
  tmp: TExecStatusType;
begin
  tmp := PQresultStatus(res);
  Result := (tmp = PGRES_TUPLES_OK) or (tmp = PGRES_COMMAND_OK);
end;

function TPgSqlRes.cmdStatus: string;
begin
  Result := PQcmdStatus(res);
end;

function TPgSqlRes.oidStatus: string;
begin
  Result := PQoidStatus(res);
end;


initialization
{$IFDEF WINDOWS}
postgres3dyn.InitialisePostgres3;
{$ENDIF}

finalization
{$IFDEF WINDOWS}
 postgres3dyn.ReleasePostgres3;
{$ENDIF}

end.

