unit uParam;

interface

uses Rubies, DB;

var
  cParam, cParams: Tvalue;

function ap_iParam(real: TParam; owner: Tvalue): Tvalue;
function ap_iParams(real: TParams; owner: Tvalue): Tvalue;
procedure Init_Param;

implementation

uses TypInfo,SysUtils, Classes, uDefUtils, Pythia, uRDB;

function Param_alloc(This: Tvalue; real: TParam): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

function ap_iParam(real: TParam; owner: Tvalue): Tvalue;
begin
  result := Param_alloc(cParam, real);
  ap_owner(result, owner);
end;

function ap_iParam_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iParam(TParam(obj), owner);
end;

function Param_assign(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
  source: TPersistent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TPersistent, source);
  real.Assign(source);
  result := This;
end;

function Param_load(This, v, blob_t: Tvalue): Tvalue; cdecl;
var
  real: TParam;
  stream: TStream;
  BlobType: TBlobType;
begin
  real := ap_data_get_struct(This);
  BlobType := TBlobType(FIX2INT(blob_t));
  case RTYPE(v) of
  T_STRING:
    try
      real.LoadFromFile(dl_String(v), BlobType);
    except
      on E: EFOpenError do
        ap_raise(ap_eIOError, E.message);
    end;
  T_DATA:
    try
      ap_data_get_object(v, TStream, stream);
      real.LoadFromStream(stream, BlobType);
    except
      on E: EReadError do;
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := This;
end;

function Param_get_type(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(Ord(real.DataType));
end;

function Param_get_to_f(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := rb_float_new(real.AsFloat);
end;

function Param_get_to_i(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.AsInteger);
end;

function Param_get_to_s(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  case real.DataType of
  ftTime:
    result := ap_String(TimeToStr(real.AsTime));
  ftDate, ftDateTime, ftTimeStamp:
    result := ap_String(DateTimeToStr(real.AsDateTime));
  else
    result := ap_String(real.AsString);
  end;
end;

function Param_get_name(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := rb_str_new2(PChar(real.Name));
end;

function Param_set_as_memo(This,v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsMemo := dl_String(v);
  result := v;
end;

procedure Params_setup(obj: Tvalue; real: TParams);
begin
  Collection_setup(obj, real);
end;

function Params_alloc(This: Tvalue; real: TParams): Tvalue;
begin
  result := TmpAlloc(This, real);
  Params_setup(result, real);
end;

function ap_iParams(real: TParams; owner: Tvalue): Tvalue;
begin
  result := Params_alloc(cParams, real);
  ap_owner(result, owner);
end;

function ap_iParams_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iParams(TParams(obj), owner);
end;

function Params_aref(This, p: Tvalue): Tvalue; cdecl;
var
  real: TParams;
  Param: TParam;
  S: string;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  Param := nil;

  case RTYPE(p) of
  T_STRING:
    begin
      S := dl_String(p);
      Param := real.ParamByName(S);
    end;
  T_FIXNUM:
    begin
      n := FIX2INT(p);
      if (n < 0) or (real.Count <= n) then
        ap_raise(ap_eIndexError, sOut_of_range);
      Param := real[n];
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;

  if Param = nil then
    result := Qnil
  else
    result := Collection_aref(This, ap_Fixnum(Param.Index));
end;

function Params_aset(This, p, v: Tvalue): Tvalue; cdecl;
var
  n: Integer;
  real: TParams;
  Param: TParam;
  klass: Tvalue;
  klass_name: string;
  DateTime: TDateTime;
  kind_p: Tvalue;
begin
  real := ap_data_get_struct(This);
  Param := nil;

  case RTYPE(p) of
  T_STRING:
    try
      Param := real.ParamByName(dl_String(p));
    except
      on E: Exception do
        ap_raise(ap_eDatabaseError, E.message);
    end;
  T_FIXNUM:
    begin
      n := FIX2INT(p);
      if (n < 0) or (real.Count <= n) then
        ap_raise(ap_eIndexError, sOut_of_range);
      Param := real[n];
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;

  if Param = nil then
    result := Qnil
  else
  begin
    try
      case RTYPE(v) of
      T_NIL   : Param.Clear;
      T_STRING:
        if Param.DataType = ftMemo then
          Param.AsMemo     := dl_String(v)
        else
          Param.AsString   := dl_String(v)
        ;
      T_FIXNUM: Param.AsInteger  := FIX2INT(v);
      T_BIGNUM: Param.AsCurrency := NUM2INT(v);
      T_FLOAT : Param.AsFloat    := NUM2DBL(v);
      T_TRUE  : Param.AsBoolean  := True;
      T_FALSE : Param.AsBoolean  := False;
      T_DATA:
        begin
          klass := CLASS_OF(v);
          klass := rb_class_path(klass);
          klass_name := dl_String(klass);
          kind_p := rb_obj_is_kind_of(v, ap_cDateTime);
          if RTEST(kind_p) then
          begin
            DateTime := PDateTime(ap_data_get_struct(v))^;
            if DateTime < 1 then
              Param.AsTime := DateTime
            else
              Param.AsDateTime := DateTime;
          end
          else
            Param.AsString := 'Unknown '+klass_name+':class';
        end;
      else
        ap_raise(ap_eArgError, sWrong_arg_type);
      end;
    except
      on E: Exception do
        ap_raise(ap_eDatabaseError, E.message);
    end;
    result := ap_iParam(Param, This);
    Collection_aset(This, ap_Fixnum(Param.Index), result);
  end;
end;

function Param_assign_field(This, Field : Tvalue): Tvalue; cdecl;
var
  real: TParam;
  dl_Field : TField;
begin
  real := ap_data_get_struct(This);
  dl_Field := ap_data_get_struct(Field);
  real.AssignField( dl_Field );
  result := This;
end;

function Param_assign_field_value(This, Field, Value : Tvalue): Tvalue; cdecl;
var
  real: TParam;
  dl_Field : TField;
  dl_Value : Variant;
begin
  real := ap_data_get_struct(This);
  dl_Field := ap_data_get_struct(Field);
  dl_Value := dl_Variant(Value);
  real.AssignFieldValue( dl_Field, dl_Value );
  result := This;
end;

function Param_clear(This : Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.Clear;
  result := This;
end;

function Param_get_data_size(This : Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.GetDataSize);
end;

function Param_load_from_file(This, FileName, BlobType : Tvalue): Tvalue; cdecl;
var
  real: TParam;
  dl_FileName : string;
  dl_BlobType : TBlobType;
begin
  real := ap_data_get_struct(This);
  dl_FileName := dl_String(FileName);
  dl_BlobType := TBlobType(dl_Integer(BlobType));
  real.LoadFromFile( dl_FileName, dl_BlobType );
  result := This;
end;

function Param_load_from_stream(This, Stream, BlobType : Tvalue): Tvalue; cdecl;
var
  real: TParam;
  dl_Stream : TStream;
  dl_BlobType : TBlobType;
begin
  real := ap_data_get_struct(This);
  dl_Stream := ap_data_get_struct(Stream);
  dl_BlobType := TBlobType(dl_Integer(BlobType));
  real.LoadFromStream( dl_Stream, dl_BlobType );
  result := This;
end;

function Param_get_as_blob(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.AsBlob);
end;

function Param_set_as_blob(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsBlob := dl_String(v);
  result := v;
end;

function Param_get_as_boolean(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.AsBoolean);
end;

function Param_set_as_boolean(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsBoolean := dl_Boolean(v);
  result := v;
end;

function Param_get_as_date(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_DateTime(real.AsDate);  // uses uDateTime
end;

function Param_set_as_date(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsDate := dl_DateTime(v);
  result := v;
end;

function Param_get_as_date_time(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_DateTime(real.AsDateTime);  // uses uDateTime
end;

function Param_set_as_date_time(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsDateTime := dl_DateTime(v);
  result := v;
end;

function Param_get_as_float(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Float(real.AsFloat);
end;

function Param_set_as_float(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsFloat := dl_Double(v);
  result := v;
end;

function Param_get_as_integer(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.AsInteger);
end;

function Param_set_as_integer(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsInteger := dl_Integer(v);
  result := v;
end;

function Param_get_as_small_int(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.AsSmallInt);
end;

function Param_set_as_small_int(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsSmallInt := dl_Integer(v);
  result := v;
end;

function Param_get_as_memo(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.AsMemo);
end;

function Param_get_as_string(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.AsString);
end;

function Param_set_as_string(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsString := dl_String(v);
  result := v;
end;

function Param_get_as_time(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_DateTime(real.AsTime);  // uses uDateTime
end;

function Param_set_as_time(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsTime := dl_DateTime(v);
  result := v;
end;

function Param_get_as_word(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.AsWord);
end;

function Param_set_as_word(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.AsWord := dl_Integer(v);
  result := v;
end;

function Param_get_bound(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.Bound);
end;

function Param_set_bound(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.Bound := dl_Boolean(v);
  result := v;
end;

function Param_get_is_null(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.IsNull);
end;

function Param_get_native_str(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.NativeStr);
end;

function Param_set_native_str(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.NativeStr := dl_String(v);
  result := v;
end;

function Param_get_text(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.Text);
end;

function Param_set_text(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.Text := dl_String(v);
  result := v;
end;

function Param_get_value(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  result := ap_Variant(real.Value);
end;

function Param_set_value(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParam;
begin
  real := ap_data_get_struct(This);
  real.Value := dl_Variant(v);
  result := v;
end;

function IntToConstName(c:Integer;TypeInfo:PTypeInfo):String;  // common use!!
var
  TypeData: PTypeData;
  T: PTypeData;
  P: ^ShortString;
  Value: integer;
begin
  TypeData := GetTypeData(TypeInfo);
  T := GetTypeData(TypeData^.BaseType^);
  P := @T^.NameList;
  result := '';
  for Value := T^.MinValue to T^.MaxValue do
  begin
    if c = Value then begin
      result := P^;
      break;
    end;
    Inc(Integer(P), Length(P^) + 1);
  end;
end;

function Param_inspect(This: Tvalue): Tvalue; cdecl;
var
  real: TParam;
  klass: Tvalue;
  dlv_inspect:String;
  dlv_data_type:String;
begin
  real := ap_data_get_struct(This);
  klass := CLASS_OF(This);
  if (real = nil) // or (real.Value = nil) or (real.Value.tag = nil)
    then dlv_inspect := 'nil'
    else dlv_inspect := dl_String(rb_Inspect(ap_Variant(real.Value)));
  dlv_data_type := IntToConstName(ord(real.DataType),TypeInfo(TFieldType));
  result := ap_String(
    '#<'+dl_String(rb_class_path(klass))+':'+
       ' name='''+real.Name+''''+
       ' data_type='+rb_class2name(mRDB)+'::'+UpperCase1(dlv_data_type)+
       ' value='+dlv_Inspect+
    '>'
    );
end;

procedure Init_Param;
begin
  DefineConstSetType(mRDB, TypeInfo(TParamType));

  cParam := DefinePersistentClass(mRDB, TParam, ap_cCollectionItem, ap_iParam_v);
  rb_define_method(cParam, 'assign', @Param_assign, 1);
  rb_define_method(cParam, 'load', @Param_load, 1); // vcl: load_from_file, load_from_stream
  DefineAttrGet(cParam, 'type', Param_get_type); // vcl: DataType
  DefineAttrGet(cParam, 'to_f', Param_get_to_f); // vcl: AsFloat
  DefineAttrGet(cParam, 'to_i', Param_get_to_i); // vcl: AsInteger
  DefineAttrGet(cParam, 'to_s', Param_get_to_s); // vcl: AsString
  DefineAttrGet(cParam, 'name', Param_get_name);
  DefineAttrSet(cParam, 'as_memo', Param_set_as_memo);

  cParams := DefinePersistentClass(mRDB, TParams, ap_cCollection, ap_iParams_v);
  SetCollectionItemClass(cParams, 'TParam');
  rb_define_method(cParams, '[]', @Params_aref, 1);
  rb_define_method(cParams, '[]=', @Params_aset, 2);

  rb_define_method(cParam, 'assign_field', @Param_assign_field, 1);
  rb_define_method(cParam, 'assign_field_value', @Param_assign_field_value, 2);
  rb_define_method(cParam, 'clear', @Param_clear, 0);
  rb_define_method(cParam, 'get_data_size', @Param_get_data_size, 0);
  rb_define_method(cParam, 'load_from_file', @Param_load_from_file, 2);
  rb_define_method(cParam, 'load_from_stream', @Param_load_from_stream, 2);
  DefineAttrGet(cParam, 'as_blob', Param_get_as_blob);
  DefineAttrSet(cParam, 'as_blob', Param_set_as_blob);
  DefineAttrGet(cParam, 'as_boolean', Param_get_as_boolean);
  DefineAttrSet(cParam, 'as_boolean', Param_set_as_boolean);
  DefineAttrGet(cParam, 'as_date', Param_get_as_date);
  DefineAttrSet(cParam, 'as_date', Param_set_as_date);
  DefineAttrGet(cParam, 'as_date_time', Param_get_as_date_time);
  DefineAttrSet(cParam, 'as_date_time', Param_set_as_date_time);
  DefineAttrGet(cParam, 'as_float', Param_get_as_float);
  DefineAttrSet(cParam, 'as_float', Param_set_as_float);
  DefineAttrGet(cParam, 'as_integer', Param_get_as_integer);
  DefineAttrSet(cParam, 'as_integer', Param_set_as_integer);
  DefineAttrGet(cParam, 'as_small_int', Param_get_as_small_int);
  DefineAttrSet(cParam, 'as_small_int', Param_set_as_small_int);
  DefineAttrGet(cParam, 'as_memo', Param_get_as_memo);
  DefineAttrGet(cParam, 'as_string', Param_get_as_string);
  DefineAttrSet(cParam, 'as_string', Param_set_as_string);
  DefineAttrGet(cParam, 'as_time', Param_get_as_time);
  DefineAttrSet(cParam, 'as_time', Param_set_as_time);
  DefineAttrGet(cParam, 'as_word', Param_get_as_word);
  DefineAttrSet(cParam, 'as_word', Param_set_as_word);
  DefineAttrGet(cParam, 'bound', Param_get_bound);
  DefineAttrGet(cParam, 'bound?', Param_get_bound);
  DefineAttrSet(cParam, 'bound', Param_set_bound);
  DefineAttrGet(cParam, 'is_null', Param_get_is_null);
  DefineAttrGet(cParam, 'is_null?', Param_get_is_null);
  DefineAttrGet(cParam, 'native_str', Param_get_native_str);
  DefineAttrSet(cParam, 'native_str', Param_set_native_str);
  DefineAttrGet(cParam, 'text', Param_get_text);
  DefineAttrSet(cParam, 'text', Param_set_text);
  DefineAttrGet(cParam, 'value', Param_get_value);
  DefineAttrSet(cParam, 'value', Param_set_value);
  rb_define_method(cParam, 'inspect', @Param_inspect, 0);
end;

exports
  ap_iParams;

end.
