unit uSQLConnection;

interface

uses Rubies, SqlExpr, DBXpress;

var
  cSQLConnection: Tvalue;

function ap_cSQLConnection: Tvalue;
function ap_iSQLConnection(real: TSQLConnection; owner: Tvalue): Tvalue;
procedure Init_SQLConnection;

implementation

uses
  SysUtils, Classes, DB, uDefUtils, Pythia, uRDBExt,
  uSQLDataSet, uSQLTable, uSQLQuery, uSQLStoredProc;

var
  TD: TTransactionDesc;

function ap_cSQLConnection: Tvalue;
begin
  result := cSQLConnection;
end;

function SQLConnection_event_handle(This, name: Tvalue): Tvalue; cdecl;
begin
  EventHandle(This, name, [RDBGetHandle]);
  result := Qnil;
end;

procedure CompoFree(real: TComponent); cdecl;
begin
  try
    real.tag := 0;
    if csDestroying in real.ComponentState then
      PhiObjectList.Extract(real)
    else
      PhiObjectList.Remove(real);
  except
    on E: Exception do;
  end;
end;

procedure SQLConnection_free(real: TSQLConnection); cdecl;
begin
  if real.Connected then real.Close;
  CompoFree(real);
end;

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

function SQLConnection_alloc(This: Tvalue; real: TSQLConnection): Tvalue;
begin
  result := ChildAlloc(This, real);
end;

function ap_iSQLConnection(real: TSQLConnection; owner: Tvalue): Tvalue;
begin
  result := SQLConnection_alloc(cSQLConnection, real);
  ap_owner(result, owner);
end;

function ap_iSQLConnection_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iSQLConnection(TSQLConnection(obj), owner)
end;

function SQLConnection_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
  args: array of Tvalue;
begin
  real := TSQLConnection.Create(nil);
  if argc > 0 then
  begin
    SetLength(args, argc);
    args := argv;
    try
      real.ConnectionName := dl_String(args[0]);
      real.LoginPrompt := False;
      real.LoadParamsOnConnect := True;
    except
      on E: Exception do
        ap_raise(ap_eDatabaseError, E.message);
    end;
  end;
  result := SQLConnection_alloc1(This, real);
  rb_obj_call_init(result, argc, argv);
end;

function SQLConnection_execute(argc: integer; argv: Tvalue_array; This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
  dl_params: TParams;
  dl_sql: String;
begin
  result := Qnil;
  real := ap_data_get_struct(This);
  dl_params := nil;
  if argc > 2 then ap_raise(ap_eArgError, sWrong_num_of_args);
  if argc > 1 then ap_data_get_object(argv[1], TParams, dl_params);
  dl_sql := dl_String(argv[0]);
  try
    if dl_params <> nil
      then result := ap_Integer(real.Execute(dl_sql, dl_params))
      else result := ap_Integer(real.ExecuteDirect(dl_sql));
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function SQLConnection_execute_direct(This, sql: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  result := Qnil;
  real := ap_data_get_struct(This);
  try
    result := INT2FIX(real.ExecuteDirect(dl_String(sql)));
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function SQLConnection_open(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.Open;
  result := This;
end;

function SQLConnection_close(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.Close;
  result := This;
end;

function SQLConnection_close_datasets(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.CloseDatasets;
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function SQLConnection_commit(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.Commit(TD);
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function SQLConnection_rollback(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.Rollback(TD);
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function SQLConnection_start_transaction(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.StartTransaction(TD);
  except on E: Exception do
    ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function SQLConnection_load_params_from_ini_file(This, fname: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.LoadParamsFromIniFile(dl_String(fname));
  except on E: Exception do
    ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function SQLConnection_get_table_names(argc: integer; argv: Tvalue_array; This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
  SystemTable : boolean;
begin
  result := ap_StringList_new;
  real := ap_data_get_struct(This);
  SystemTable := False; // default
  if argc > 1 then ap_raise(ap_eArgError, sWrong_num_of_args);
  if argc > 0 then SystemTable := dl_Boolean(argv[0]);
  real.GetTableNames( dl_Strings(result), SystemTable );
end;

function SQLConnection_get_index_names(This,table: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_StringList_new;
  real.GetIndexNames( dl_String(table),dl_Strings(result) );
end;

function SQLConnection_get_params(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.Params, This);
end;

function SQLDataSetTmpAlloc(DataSet: TCustomSQLDataSet; owner: Tvalue): Tvalue;
begin
  if DataSet is TSQLDataSet then
    result := ap_iSQLDataSet(TSQLDataSet(DataSet), owner)
  else if DataSet is TSQLTable then
    result := ap_iSQLTable(TSQLTable(DataSet), owner)
  else if DataSet is TSQLQuery then
    result := ap_iSQLQuery(TSQLQuery(DataSet), owner)
  else if DataSet is TSQLStoredProc then
    result := ap_iSQLStoredProc(TSQLStoredProc(DataSet), owner)
  else
    result := Qnil { error };
end;

function SQLConnection_get_data_sets(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
  i:integer;
begin
  result := rb_ary_new;
  real := ap_data_get_struct(This);
  try
    for i := 0 to real.DataSetCount-1 do
    begin
      rb_ary_push(result, SQLDataSetTmpAlloc(real.DataSets[i], This));
    end;
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function SQLConnection_clone_connection(This : Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_iSQLConnection(real.CloneConnection,This);
end;

function SQLConnection_close_data_sets(This : Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.CloseDataSets;
  result := This;
end;

function SQLConnection_set_trace_callback_event(This, Event, IClientInfo : Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
  dl_Event : TSQLCallbackEvent;
  dl_IClientInfo : Integer;
begin
  real := ap_data_get_struct(This);
  dl_Event := ap_data_get_struct(Event);
  dl_IClientInfo := dl_Integer(IClientInfo);
  real.SetTraceCallbackEvent( dl_Event, dl_IClientInfo );
  result := This;
end;

function SQLConnection_get_auto_clone(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.AutoClone);
end;

function SQLConnection_set_auto_clone(This, v: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.AutoClone := dl_Boolean(v);
  result := v;
end;

function SQLConnection_get_in_transaction(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.InTransaction);
end;

function SQLConnection_get_params_loaded(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.ParamsLoaded);
end;

function SQLConnection_set_params_loaded(This, v: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.ParamsLoaded := dl_Boolean(v);
  result := v;
end;

function SQLConnection_get_sql_hour_glass(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.SQLHourGlass);
end;

function SQLConnection_set_sql_hour_glass(This, v: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.SQLHourGlass := dl_Boolean(v);
  result := v;
end;

function SQLConnection_get_field_names(This, TableName : Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
  dl_TableName : string;
begin
  real := ap_data_get_struct(This);
  dl_TableName := dl_String(TableName);
  result := ap_StringList_new;
  real.GetFieldNames( dl_TableName, dl_Strings(result) );
end;

function SQLConnection_get_procedure_names(This : Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_StringList_new;
  real.GetProcedureNames( dl_Strings(result) );
end;

function SQLConnection_get_procedure_params(This, ProcedureName, List : Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
  dl_ProcedureName : string;
  dl_List : TList;
begin
  real := ap_data_get_struct(This);
  dl_ProcedureName := dl_String(ProcedureName);
  dl_List := ap_data_get_struct(List);
  real.GetProcedureParams( dl_ProcedureName, dl_List );
  result := This;
end;

function SQLConnection_get_active_statements(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.ActiveStatements);
end;

function SQLConnection_get_connection_state(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.ConnectionState));
end;

function SQLConnection_set_connection_state(This, v: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.ConnectionState := TConnectionState(dl_Integer(v));
  result := v;
end;

function SQLConnection_get_locale_code(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.LocaleCode));
end;

function SQLConnection_set_locale_code(This, v: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  real.LocaleCode := TLocaleCode(dl_Integer(v));
  result := v;
end;

function SQLConnection_get_max_stmts_per_conn(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.MaxStmtsPerConn);
end;

function SQLConnection_get_transactions_supported(This: Tvalue): Tvalue; cdecl;
var
  real: TSQLConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.TransactionsSupported);
end;

procedure Init_SQLConnection;
begin
  RDBDataSetTmpAllocFuncList.Add(@SQLDataSetTmpAlloc);

  TD.TransactionID := 1;
  TD.IsolationLevel := xilREADCOMMITTED;

  cSQLConnection := DefinePersistentClass(ap_mRDB, TSQLConnection, ap_cComponent, ap_iSQLConnection_v);
  rb_define_method(cSQLConnection, 'event_handle', @SQLConnection_event_handle, 1);
  DefineSingletonMethod(cSQLConnection, 'new', SQLConnection_new);
  rb_define_method(cSQLConnection, 'execute', @SQLConnection_execute, -1);
  rb_define_method(cSQLConnection, 'execute_direct', @SQLConnection_execute_direct, 1);
  rb_define_method(cSQLConnection, 'open', @SQLConnection_open, 0);
  rb_define_method(cSQLConnection, 'close', @SQLConnection_close, 0);
  rb_define_method(cSQLConnection, 'close_datasets', @SQLConnection_close_datasets, 0);
  rb_define_method(cSQLConnection, 'commit', @SQLConnection_commit, 0);
  rb_define_method(cSQLConnection, 'rollback', @SQLConnection_rollback, 0);
  rb_define_method(cSQLConnection, 'start_transaction', @SQLConnection_start_transaction, 0);
  rb_define_method(cSQLConnection, 'load_params_from_ini_file', @SQLConnection_load_params_from_ini_file, 1);
  rb_define_method(cSQLConnection, 'table_names', @SQLConnection_get_table_names, -1);
  rb_define_method(cSQLConnection, 'index_names', @SQLConnection_get_index_names, 1);

  DefineAttrGet(cSQLConnection, 'params', SQLConnection_get_params);
  DefineAttrGet(cSQLConnection, 'data_sets', SQLConnection_get_data_sets);

  rb_define_method(cSQLConnection, 'clone_connection', @SQLConnection_clone_connection, 0);
  rb_define_method(cSQLConnection, 'close_data_sets', @SQLConnection_close_data_sets, 0);
  rb_define_method(cSQLConnection, 'set_trace_callback_event', @SQLConnection_set_trace_callback_event, 2);
  DefineAttrGet(cSQLConnection, 'auto_clone', SQLConnection_get_auto_clone);
  DefineAttrGet(cSQLConnection, 'auto_clone?', SQLConnection_get_auto_clone);
  DefineAttrSet(cSQLConnection, 'auto_clone', SQLConnection_set_auto_clone);
  DefineAttrGet(cSQLConnection, 'in_transaction', SQLConnection_get_in_transaction);
  DefineAttrGet(cSQLConnection, 'in_transaction?', SQLConnection_get_in_transaction);
  DefineAttrGet(cSQLConnection, 'params_loaded', SQLConnection_get_params_loaded);
  DefineAttrGet(cSQLConnection, 'params_loaded?', SQLConnection_get_params_loaded);
  DefineAttrSet(cSQLConnection, 'params_loaded', SQLConnection_set_params_loaded);
  DefineAttrGet(cSQLConnection, 'sql_hour_glass', SQLConnection_get_sql_hour_glass);
  DefineAttrGet(cSQLConnection, 'sql_hour_glass?', SQLConnection_get_sql_hour_glass);
  DefineAttrSet(cSQLConnection, 'sql_hour_glass', SQLConnection_set_sql_hour_glass);
  rb_define_method(cSQLConnection, 'get_field_names', @SQLConnection_get_field_names, 1);
  rb_define_method(cSQLConnection, 'get_procedure_names', @SQLConnection_get_procedure_names, 0);
  DefineAttrGet(cSQLConnection, 'active_statements', SQLConnection_get_active_statements);
  DefineAttrGet(cSQLConnection, 'connection_state', SQLConnection_get_connection_state);
  DefineAttrSet(cSQLConnection, 'connection_state', SQLConnection_set_connection_state);
  DefineAttrGet(cSQLConnection, 'locale_code', SQLConnection_get_locale_code);
  DefineAttrSet(cSQLConnection, 'locale_code', SQLConnection_set_locale_code);
  DefineAttrGet(cSQLConnection, 'max_stmts_per_conn', SQLConnection_get_max_stmts_per_conn);
  DefineAttrGet(cSQLConnection, 'transactions_supported', SQLConnection_get_transactions_supported);
  DefineAttrGet(cSQLConnection, 'transactions_supported?', SQLConnection_get_transactions_supported);
end;

end.
