unit uTable;

interface

uses DBTables, Rubies;

var
  cTable: Tvalue;

function ap_cTable: Tvalue;
function ap_iTable(real: TTable; owner: Tvalue): Tvalue;
procedure Init_Table;

implementation

uses SysUtils, uDefUtils, Pythia{, uDataSet}, uRDBExt{, uFieldDef, uIndexDef};

function ap_cTable: Tvalue;
begin
  result := cTable;
end;

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

function Table_alloc(This: Tvalue; real: TTable): Tvalue;
begin
  result := ChildAlloc(This, real);
  Table_setup(result, real);
end;

function ap_iTable(real: TTable; owner: Tvalue): Tvalue;
begin
  result := Table_alloc(cTable, real);
  ap_owner(result, owner);
end;

function ap_iTable_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iTable(TTable(obj), owner)
end;

function Table_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TTable;
  p: Pvalue;
  Database: TDatabase;
  v: Tvalue;
begin
  real := TTable.Create(nil);
  result := DataSet_alloc(This, real);
  Table_setup(result, real);

  if argc > 0 then begin
    p := argv;
    try
      if p^ <> Qnil then
      begin
        v := p^; inc(p);
        case RTYPE(v) of
        T_STRING:
          real.DatabaseName := dl_String(v);
        else
          ap_data_get_object(v, TDatabase, Database);
          rb_iv_set(result, '@database', v);
          real.DatabaseName := Database.DatabaseName;
          real. SessionName := Database. SessionName;
        end;
      end;
      if argc > 1 then
      begin
        real.TableName := dl_String(p^);
      end;
    except
      on E: Exception do
        ap_raise(ap_eDatabaseError, E.message);
    end;
  end;

  ap_obj_call_init(result, argc, argv);
end;

function Table_get_exists(This: Tvalue): Tvalue; cdecl;
var
  real: TTable;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.Exists);
end;

function Table_create_table(This: Tvalue): Tvalue; cdecl;
var
  real: TTable;
begin
  real := ap_data_get_struct(This);
  real.CreateTable;
  result := This;
end;

function Table_empty_table(This: Tvalue): Tvalue; cdecl;
begin
  TTable(ap_data_get_struct(This)).EmptyTable;
  result := This;
end;

function Table_rename_table(This, v: Tvalue): Tvalue; cdecl;
begin
  TTable(ap_data_get_struct(This)).RenameTable(dl_String(v));
  result := This;
end;

function Table_delete_table(This: Tvalue): Tvalue; cdecl;
begin
  TTable(ap_data_get_struct(This)).DeleteTable;
  result := This;
end;

function Table_open_index_file(This, v: Tvalue): Tvalue; cdecl;
begin
  TTable(ap_data_get_struct(This)).OpenIndexFile(dl_String(v));
  result := This;
end;

function Table_close_index_file(This, v: Tvalue): Tvalue; cdecl;
begin
  TTable(ap_data_get_struct(This)).CloseIndexFile(dl_String(v));
  result := This;
end;

function Table_delete_index(This, v: Tvalue): Tvalue; cdecl;
begin
  TTable(ap_data_get_struct(This)).DeleteIndex(dl_String(v));
  result := This;
end;

function Table_find(This, v: Tvalue; nearest: Boolean): Tvalue;
var
  real: TTable;
  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 Table_find_nearest(This, v: Tvalue): Tvalue; cdecl;
begin
  result := Table_find(This, v, True);
end;

function Table_find_key(This, v: Tvalue): Tvalue; cdecl;
begin
  result := Table_find(This, v, False);
end;

function Table_get_index_names(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_StringList_new;
  TTable(ap_data_get_struct(This)).GetIndexNames(dl_Strings(result));
end;

procedure Init_Table;
begin
  DefineConstSetType(ap_mRDB, TypeInfo(TTableType));
  cTable := DefinePersistentClass(ap_mRDB, TTable, ap_cDataSet, ap_iTable_v);
  DefineSingletonMethod(cTable, 'new', Table_new);
  DefineAttrGet(cTable, 'exist?', Table_get_exists);
  rb_define_method(cTable, 'create_table', @Table_create_table, 0);
  rb_define_method(cTable, 'empty_table', @Table_empty_table, 0);
  rb_define_method(cTable, 'rename_table', @Table_rename_table, 1);
  rb_define_method(cTable, 'delete_table', @Table_delete_table, 0);
  rb_define_method(cTable, 'open_index_file', @Table_open_index_file, 1);
  rb_define_method(cTable, 'close_index_file', @Table_close_index_file, 1);
  rb_define_method(cTable, 'delete_index', @Table_delete_index, 1);
  rb_define_method(cTable, 'find_nearest', @Table_find_nearest, 1);
  rb_define_method(cTable, 'find_key', @Table_find_key, 1);
  rb_define_method(cTable, 'index_names', @Table_get_index_names, 0);
end;

end.
