unit upgsql;

interface

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

type
  { TPgSqlRes }
  TPgSqlRes = class
  private
    res: PPGresult;
    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 kFieldOf(nombre: string): integer;

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

    // funciones para lectura por nombre.
    function GetI(krow: integer; nombre: string): integer;
    function GetF(krow: integer; nombre: string): double;
    function GetS(krow: integer; nombre: string): string;
    function GetDT(krow: integer; nombre: string): TDateTime;

    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;

    function next: integer;
    function EOF: boolean;
    procedure First;

    function nRows: 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;
  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 );
  result:= respg.nRows;
  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.nRows <> 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 >= nRows 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;



function TPgSqlRes.next: integer;
var
  i: Integer;
begin
  inc( kRec );
  if kRec >= nRows 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 (nRows=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.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.nRows: integer;
var
  resx: longint;
begin
  resx:=  PQntuples(res);
  result:= resx;
end;

function TPgSqlRes.kFieldOf(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): integer;
var
  s: string;
begin
  s := GetValue(krow, kFieldOf(nombre));
  if s = '' then
    Result := 0
  else
    Result := StrToInt(s);
end;

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

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

function TPgSqlRes.GetDT(krow: integer; nombre: string): TDateTime;
var
  s: string;
begin
  s := GetValue(krow, kFieldOf(nombre));
  if s = '' then
    Result := 0
  else
    Result:= IsoStrToDateTime(s);
//    Result := StrToDateTime(s);
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.

