unit uClientDataSet;

interface

uses Rubies, DBClient;

var
  cClientDataSet: Tvalue;

function ap_cClientDataSet: Tvalue;
procedure Init_ClientDataSet;

implementation

uses
  SysUtils, Classes,
  DB,
  uDefUtils, Pythia,
  RDBHandle, uRDB, uDataSet, uIndexDef;

function ap_cClientDataSet: Tvalue;
begin
  result := cClientDataSet;
end;

procedure ClientDataSet_free(real: TClientDataSet); cdecl;
begin
//rb_p(ap_String('ClientDataSet_free1:'+real.ClassName));
  real.SetProvider(nil);
  if real.Active then real.Close;
  CompoFree(real);
//rb_p(ap_String('ClientDataSet_free2'));
end;

// CompoAlloc modified
function ClientDataSet_alloc1(This: Tvalue; real: TClientDataSet): Tvalue;
begin
  if real = nil then begin result := Qnil; exit; end;
  PhiObjectList.Add(real);
  result := rb_data_object_alloc(This, real, nil, @ClientDataSet_free);
  rb_iv_set(result, '@events', rb_hash_new);
  real.tag := result;
end;

procedure ClientDataSet_setup(obj: Tvalue; real: TClientDataSet);
begin
  DataSet_setup(obj, real);
  rb_iv_set(obj, '@index_defs', ap_iIndexDefs(real.IndexDefs, obj));
end;

function ClientDataSet_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
begin
  real := TClientDataSet.Create(nil);
  result := ClientDataSet_alloc1(This, real);
  ClientDataSet_setup(result, real);

  ap_obj_call_init(result, argc, argv);
end;

function ClientDataSet_open(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
  args: array of Tvalue;
begin
//rb_p(ap_String('ClientDataSet_open'));
  real := ap_data_get_struct(This);
  if argc > 0 then
  begin
    SetLength(args, argc);
    args := argv;
    real.Close;
    real.CommandText := dl_String(args[0]);
  end;
  real.Open;
  result := This;
end;

function ClientDataSet_get_change_count(This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.ChangeCount);
end;

function ClientDataSet_save(This, file_name, data_packet_format: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
  n: Integer;
  Format: TDataPacketFormat;
begin
  real := ap_data_get_struct(This);
  n := dl_Integer(data_packet_format);
  if (n < Ord(Low(TDataPacketFormat))) or (Ord(High(TDataPacketFormat)) < n) then
    ap_raise(ap_eIndexError, sOut_of_range);
  Format := TDataPacketFormat(n);
  real.SaveToFile(dl_String(file_name), Format);
  result := This;
end;

function ClientDataSet_load(This, file_name: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
begin
  real := ap_data_get_struct(This);
  real.LoadFromFile(dl_String(file_name));
  result := This;
end;

function ClientDataSet_find(This, v: Tvalue; nearest: Boolean): Tvalue;
var
  real: TClientDataSet;
  len: Integer;
  ptr: Pvalue;
  i: Integer;
  TmpValues: array of Variant;
  KeyValues: array of TVarRec;

  procedure set_len(_len: Integer);
  begin
    len := _len;
    SetLength(KeyValues, len);
    SetLength(TmpValues, len);
  end;

  procedure set_val(v: Tvalue; i: Integer);
  begin
    TmpValues[i] := dl_Variant(v);
    KeyValues[i].VType := vtVariant;
    KeyValues[i].VVariant := @TmpValues[i];
  end;

begin
  result := Qnil;
  try
    case RTYPE(v) of
    T_ARRAY:
      begin
        set_len(ap_ary_len(v));
        ptr := ap_ary_ptr(v);
        for i := 0 to len-1 do
        begin
          set_val(ptr^, i);
          Inc(ptr);
        end;
      end;
    else
      set_len(1);
      set_val(v, 0);
    end;
    real := ap_data_get_struct(This);
    if nearest then
    begin
      real.FindNearest(KeyValues);
      result := This;
    end else
      result := ap_bool(real.FindKey(KeyValues));
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function ClientDataSet_find_nearest(This, v: Tvalue): Tvalue; cdecl;
begin
  result := ClientDataSet_find(This, v, True);
end;

function ClientDataSet_find_key(This, v: Tvalue): Tvalue; cdecl;
begin
  result := ClientDataSet_find(This, v, False);
end;

function ClientDataSet_get_index_names(This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
begin
  result := ap_StringList_new;
  real := ap_data_get_struct(This);
  real.GetIndexNames(dl_Strings(result));
end;

function ClientDataSet_apply_updates(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
  args: array of Tvalue;
  max_errors:Integer;
begin
  max_errors := 0;
  real := ap_data_get_struct(This);
  if argc > 0 then
  begin
    SetLength(args, argc);
    args := argv;
    max_errors := dl_Integer(args[0]);
  end;
  result := ap_Integer(real.ApplyUpdates(max_errors));
end;

function ClientDataSet_cancel_updates(This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
begin
  real := ap_data_get_struct(This);
  real.CancelUpdates;
  result := This;
end;

function ClientDataSet_create_data_set(This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
begin
  real := ap_data_get_struct(This);
  result := This;
  real.CreateDataSet;
end;

function ClientDataSet_set_provider(This, v: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
  provider: TComponent;
begin
  real := ap_data_get_struct(This);
  provider := ap_data_get_struct(v);
  result := This;
  real.SetProvider( provider );
end;

function ClientDataSet_add_index(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TClientDataSet;
  args: array of Tvalue;
  Name, Fields: string;
  OptionsInt: Integer;
  Options: TIndexOptions absolute OptionsInt;
  DescFields: string;
  CaseInsFields: string;
  GroupingLevel: Integer;
begin
  DescFields := '';
  CaseInsFields := '';
  GroupingLevel := 0;
  //
  real := ap_data_get_struct(This);
  SetLength(args, argc);
  args := argv;
  if argc < 3 then ap_raise(ap_eArgError, sToo_few_args);
  Name := dl_String(args[0]);
  Fields := dl_String(args[1]);
  OptionsInt := dl_Set(args[2]);
  if argc > 3 then DescFields := dl_String(args[3]);
  if argc > 4 then CaseInsFields := dl_String(args[4]);
  if argc > 5 then GroupingLevel := dl_Integer(args[5]);
  real.AddIndex(Name, Fields, Options, DescFields, CaseInsFields, GroupingLevel);
  result := this;
end;

procedure Init_ClientDataSet;
begin
  DefineConstSetType(mRDB, TypeInfo(TDataPacketFormat));
  cClientDataSet := DefinePersistentClass(mRDB, TClientDataSet, cDataSet, nil);
  DefineSingletonMethod(cClientDataSet, 'new', ClientDataSet_new);
//  rb_define_method(cClientDataSet, 'open', @ClientDataSet_open, -1);
  DefineAttrGet(cClientDataSet, 'change_count',ClientDataSet_get_change_count);
  rb_define_method(cClientDataSet, 'save', @ClientDataSet_save, 2);
  rb_define_alias(cClientDataSet, 'save_to_file', 'save');
  rb_define_method(cClientDataSet, 'load', @ClientDataSet_load, 1);
  rb_define_alias(cClientDataSet, 'load_from_file', 'load');
  rb_define_method(cClientDataSet, 'find_nearest', @ClientDataSet_find_nearest, 1);
  rb_define_method(cClientDataSet, 'find_key', @ClientDataSet_find_key, 1);
  rb_define_method(cClientDataSet, 'index_names', @ClientDataSet_get_index_names, 0);
  rb_define_method(cClientDataSet, 'apply_updates', @ClientDataSet_apply_updates, -1);
  rb_define_method(cClientDataSet, 'cancel_updates', @ClientDataSet_cancel_updates, 0);
  rb_define_method(cClientDataSet, 'create_data_set', @ClientDataSet_create_data_set, 0);
  rb_define_method(cClientDataSet, 'set_provider', @ClientDataSet_set_provider, 1);
  rb_define_method(cClientDataSet, 'add_index', @ClientDataSet_add_index, -1);
end;

exports
  ap_cClientDataSet;

end.
