unit PBS.WEB.Data;

interface

uses
  System.SysUtils, System.Classes, Data.DB;

const
  xds_Filter_Prefix = '$filter=';
  xds_Filter_And    = ' and ';

  { Caveats
   1. Needs to be towards the end in the uses clause
   2. Use TDateFields for no time component or it will go wrong
  }
type
  TDateTimeField = class(Data.DB.TDateTimeField)
  private
    class var GStore_As_UTC : Boolean;
    var       FStore_As_UTC : Boolean;
  protected
    function  GetAsDateTime : TDateTime;         override;
    procedure SetAsDateTime (Value : TDateTime); override;
(*
    function  GetAsVariant : Variant; override;
    procedure SetAsVariant (Value : Variant); override;
*)
    function  GetAsString : string; override;
    procedure SetAsString (const Value : string); override;
    {$WARNINGS OFF}
    function  GetText : string;
    procedure SetText (Value : string);
    {$WARNINGS ON}
  public
    constructor Create (AOwner : TComponent); override;

    class property Default_Store_As_UTC : Boolean read  GStore_As_UTC
                                                  write GStore_As_UTC;
    property Store_As_UTC               : Boolean read FStore_As_UTC
                                                  write FStore_As_UTC;

    { Helper methods for separate date/time handling }
    function  GetDatePart : TDateTime;
    function  GetTimePart : TDateTime;
    function  GetTimeAsString : string;
    procedure SetDateAndTime (ADate : TDateTime; ATime : TDateTime);
    procedure SetDateAndTimeStr (ADate : TDateTime; ATimeStr : string);
    property  Text : string read GetText write SetText;
  end;

implementation

{ Dummy up for testing }
function UTC_To_Local (AArg : TDateTime) : TDateTime; begin Result := 0; end;
function Local_To_UTC (AArg : TDateTime) : TDateTime; begin Result := 0; end;

{ TDateTimeField }

constructor TDateTimeField.Create (AOwner : TComponent);
begin
  inherited;
  { Initialize from class default }
  FStore_As_UTC := GStore_As_UTC;
end;

function TDateTimeField.GetAsDateTime : TDateTime;
begin
  if FStore_As_UTC and (not IsNull)
  then Result := UTC_To_Local (inherited GetAsDateTime)
  else Result := inherited GetAsDateTime;
end;

procedure TDateTimeField.SetAsDateTime (Value : TDateTime);
begin
  if FStore_As_UTC
  then inherited SetAsDateTime (Local_To_UTC (Value))
  else inherited SetAsDateTime (Value);
end;

function TDateTimeField.GetAsString : string;
begin
  if FStore_As_UTC and (not IsNull)
  then Result := DateTimeToStr (UTC_To_Local(inherited GetAsDateTime))
  else Result := inherited GetAsString;
end;

procedure TDateTimeField.SetAsString (const Value : string);
var
  LDateTime: TDateTime;
begin
  if FStore_As_UTC and (Value <> '')
  then begin
       LDateTime := StrToDateTime (Value);
       inherited SetAsDateTime (Local_To_UTC(LDateTime));
  end
  else inherited SetAsString (Value);
end;

(*
function TDateTimeField.GetAsVariant : Variant;
begin
TConsole.Log ('Get-V', Name);
  if FStore_As_UTC and (not IsNull)
  then Result := THtml.UTC_To_Local (inherited GetAsVariant)
  else Result := inherited GetAsVariant;
end;

procedure TDateTimeField.SetAsVariant (Value : Variant);
begin
  if FStore_As_UTC and (not VarIsNull(Value))
  then inherited SetAsVariant (THtml.Local_To_UTC(VarToDateTime(Value)))
  else inherited SetAsVariant (Value);
end;
*)

function TDateTimeField.GetText : string;
begin
  if FStore_As_UTC and (not IsNull)
  then Result := DateTimeToStr (AsDateTime)
  else Result := inherited Text;
end;

procedure TDateTimeField.SetText (Value : string);
begin
  inherited Text := Value;
end;

function TDateTimeField.GetDatePart : TDateTime;
begin
  Result := Trunc (AsDateTime);
end;

function TDateTimeField.GetTimePart : TDateTime;
begin
  Result := Frac (AsDateTime);
end;

function TDateTimeField.GetTimeAsString : string;
begin
  Result := FormatDateTime ('hh:nn', AsDateTime);
end;

procedure TDateTimeField.SetDateAndTime (ADate, ATime : TDateTime);
var
  LCombined : TDateTime;
  LMins     : Integer;
begin
  LCombined  := Trunc(ADate) + Frac(ATime);
  { Round to nearest minute to avoid precision issues }
  LMins      := Round(LCombined * 24 * 60);
  LCombined  := LMins / (24 * 60);
  AsDateTime := LCombined;
end;

procedure TDateTimeField.SetDateAndTimeStr (ADate : TDateTime; ATimeStr : string);
var
  LTimePart : TDateTime;
begin
  if Pos(':', ATimeStr) > 0
  then begin
    { Add seconds if not present }
    if Pos(':', Copy(ATimeStr, Pos(':', ATimeStr) + 1, Length(ATimeStr))) = 0
    then ATimeStr := ATimeStr + ':00';
    LTimePart := StrToTime (ATimeStr);
  end
  else LTimePart := 0;

  SetDateAndTime (ADate, LTimePart);
end;

initialization
  TDateTimeField.GStore_As_UTC := True;
end.