library bde;

uses
  SysUtils, Classes, Rubies, Pythia, DB,
  DBTables,
  uDatabase,
  uTable,
  uQuery,
  uStoredProc,
  uSession,
  uSessionList,
  uDefUtils, uRDBExt;

{$E so}

//from uDataSet

var
  cDBDataSet: Tvalue;

function dl_DBDataSet(This: Tvalue): TDBDataSet;
begin
  result := ap_data_get_struct(This);
end;

function DataSet_get_updates_pending(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_bool(dl_DBDataSet(This).UpdatesPending);
end;

function DataSet_apply_updates(This: Tvalue): Tvalue; cdecl;
begin
  result := This;
  dl_DBDataSet(This).ApplyUpdates;
end;

function DataSet_commit_updates(This: Tvalue): Tvalue; cdecl;
begin
  result := This;
  dl_DBDataSet(This).CommitUpdates;
end;

function DataSet_update_status(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(ord(dl_DBDataSet(This).UpdateStatus));
end;

function DataSet_get_database(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_iDatabase(dl_DBDataSet(This).Database, This);
end;

function DataSet_get_modified(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Bool(dl_DBDataSet(This).Modified);
end;

procedure Init_DBDataSet;
begin
  cDBDataSet := DefinePersistentClass(ap_mRDB, TDBDataSet, ap_cDataSet, nil);

  DefineAttrGet(cDBDataSet, 'updates_pending', DataSet_get_updates_pending);
  rb_define_method(cDBDataSet, 'apply_updates', @DataSet_apply_updates, 0);
  rb_define_method(cDBDataSet, 'update_status', @DataSet_update_status, 0);
  rb_define_method(cDBDataSet, 'commit_updates', @DataSet_commit_updates, 0);

  DefineAttrGet(cDBDataSet, 'database', DataSet_get_database);
  DefineAttrGet(cDBDataSet, 'modified', DataSet_get_modified);
  rb_define_alias(cDBDataSet, 'modified?', 'modified');
end;

//from uField
var
  cBlobStream: Tvalue;

(*
function BlobStream_alloc(This: Tvalue; real: TBlobStream): Tvalue;
*)

function BlobStream_new(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  field: TBlobField;
  mode: TBlobStreamMode;
  real: TBlobStream;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;

  ap_data_get_object(args[0], TBlobField, field);

  if argc > 1 then
    mode := TBlobStreamMode(FIX2INT(args[1]))
  else
    mode := bmRead;

  real := TBlobStream.Create(field, mode);
  result := ObjAlloc(This, real);

  ap_obj_call_init(result, argc, argv);
end;

function BlobStream_alloc(This: Tvalue; real: TBlobStream): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

procedure Field_ap_data_assign(Field: TField; v: Tvalue);
var
  data: TObject;
(*
  BlobStream: TBlobStream;
*)
begin
  try
  case RTYPE(v) of
  T_NIL:        Field.AsString  := '';
  T_STRING:     Field.AsString  := dl_String(v);
  T_FIXNUM:     Field.AsInteger := FIX2INT(v);
  T_BIGNUM:     Field.AsInteger := NUM2INT(v); //??
  T_FLOAT :     Field.AsFloat   := NUM2DBL(v);
  T_TRUE  :     Field.AsBoolean := True;
  T_FALSE :     Field.AsBoolean := False;
  T_DATA  :
    if ap_kind_of(v, ap_cDateTime) then
      Field.AsDateTime := dl_DateTime(v)
    else if Field is TBlobField then
      begin
        data := ap_data_get_struct(v);
(*
        if data is TGraphic then begin
          BlobStream := TBlobStream.Create(TBlobField(Field), bmWrite);
          try
            TIcon(data).SaveToStream(BlobStream);
          finally
            BlobStream.Free;
          end;
        end else
*)
        if data is TPersistent then
          Field.Assign(TPersistent(data));
      end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

procedure Init_BlobStream;
begin
  cBlobStream := rb_define_class_under(ap_mRDB, 'BlobStream', ap_cStream);
  DefineSingletonMethod(cBlobStream, 'new', BlobStream_new);
end;

procedure Init_bde;
begin
  if ap_mRDB = 0 then ap_loaderror('undefined RDB module');

  Init_DBDataSet;
  Init_BlobStream;

  Init_Database;
  Init_Table;
  Init_Query;
  Init_StoredProc;
  Init_Session;
  Init_SessionList;
end;

exports
  Init_bde;

exports
  ap_cDatabase,
  ap_iDatabase;

exports
  ap_cSession,
  ap_vSession;

exports
  ap_cSessionList,
  ap_vSessionList;

exports
  ap_cTable,
  ap_iTable;

var
  SaveExit: Pointer;

procedure LibExit;
begin
  Session.Free;
  Session := nil;
  ExitProc := SaveExit;
end;

begin
  SaveExit := ExitProc;
  ExitProc := @LibExit;
end.
