library http;

uses
  SysUtils, Classes, Controls, Rubies, uDefUtils, Pythia,
  NMHttp, SocketExtension, HTTPHandle, NMExtStr;

{$E so}

var
  sHeaderInfo: Tvalue;

function HeaderInfo_alloc(real: THeaderInfo): Tvalue;
var
  ary: Tvalue;
begin
  if real = nil then begin result := Qnil; Exit; end;
  ary := rb_ary_new;
  rb_ary_push(ary, ap_String(real.Cookie));
  rb_ary_push(ary, ap_String(real.LocalMailAddress));
  rb_ary_push(ary, ap_String(real.LocalProgram));
  rb_ary_push(ary, ap_String(real.Password));
  rb_ary_push(ary, ap_String(real.Referer));
  rb_ary_push(ary, ap_String(real.UserId));
  result := rb_struct_alloc(sHeaderInfo, ary);
end;

const
  props: array[0..5] of PChar = (
    'cookie',
    'mail_addr',
    'prog_name',
    'passwd',
    'referer',
    'user'
  );

procedure Init_HeaderInfo;
var
  ary: Tvalue;
  i: Integer;
begin
  ary := rb_ary_new;
  rb_ary_push(ary, rb_str_new2('HeaderInfo'));
  for i := low(props) to high(props) do
    rb_ary_push(ary, ap_String(props[i]));
  sHeaderInfo := rb_apply(ap_cStruct, rb_intern('new'), ary);
  rb_global_variable(@sHeaderInfo);
end;

procedure HTTP_setup(obj: Tvalue; real: TNMHTTP);
begin
  rb_iv_set(obj, '@send_header', ap_iStrings(real.SendHeader, obj));
  if @real.OnAboutToSend = nil then real.OnAboutToSend := handle.doAboutToSend;
  if @real.OnAuthenticationNeeded = nil then real.OnAuthenticationNeeded := handle.doAuthenticationNeeded;
  if @real.OnRedirect = nil then real.OnRedirect := handle.doRedirect;
  Socket_setup(obj, real);
end;

function HTTP_new(This: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := TNMHTTP.Create(nil);
  result := CompoAlloc(This, real);
  HTTP_setup(result, real);
  ap_obj_call_init(result, 0, nil);
end;

function HTTP_delete(This, url: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Delete(dl_String(url));
    GetSocketHandle.doSuccess(real, 'delete');
  except
    GetSocketHandle.doFailure(real, 'delete');
  end;
  result := This;
end;

function HTTP_get(This, url: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Get(dl_String(url));
    GetSocketHandle.doSuccess(real, 'get');
  except
    GetSocketHandle.doFailure(real, 'get');
  end;
  result := This;
end;

function HTTP_head(This, url: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Head(dl_String(url));
    GetSocketHandle.doSuccess(real, 'head');
  except
    GetSocketHandle.doFailure(real, 'head');
  end;
  result := This;
end;

function HTTP_options(This, url: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Options(dl_String(url));
    GetSocketHandle.doSuccess(real, 'options');
  except
    GetSocketHandle.doFailure(real, 'options');
  end;
  result := This;
end;

function HTTP_post(This, url, data: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Post(dl_String(url), dl_String(data));
    GetSocketHandle.doSuccess(real, 'post');
  except
    GetSocketHandle.doFailure(real, 'post');
  end;
  result := This;
end;

function HTTP_put(This, url, data: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Put(dl_String(url), dl_String(data));
    GetSocketHandle.doSuccess(real, 'put');
  except
    GetSocketHandle.doFailure(real, 'put');
  end;
  result := This;
end;

function HTTP_trace(This, url, data: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Trace(dl_String(url), dl_String(data));
    GetSocketHandle.doSuccess(real, 'trace');
  except
    GetSocketHandle.doFailure(real, 'trace');
  end;
  result := This;
end;

function HTTP_get_header_info(This: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  result := HeaderInfo_alloc(real.HeaderInfo);
end;

function HTTP_get_send_header(This: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
begin
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.SendHeader, This);
end;

function HTTP_set_send_header(This, v: Tvalue): Tvalue; cdecl;
var
  real: TNMHTTP;
  Strings: TStrings;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TStrings, Strings);
  try
    real.SendHeader := Strings as TExStringList;
  except
    on E: EInvalidCast do
      ap_raise(ap_eArgError, E.message);
  end;
  result := v;
end;

procedure Init_http; cdecl;
begin
  if ap_cSocket = 0 then ap_loaderror('undefined Phi::Socket class');

  Init_HeaderInfo;

  eHTTPError := rb_define_class_under(ap_mPhi, 'HTTPError', ap_eStandardError);

  cHTTP := DefinePersistentClass(ap_mPhi, TNMHTTP, ap_cSocket, nil);

  rb_define_method(cHTTP, 'delete', @HTTP_delete, 1);
  rb_define_method(cHTTP, 'get', @HTTP_get, 1);
  rb_define_method(cHTTP, 'head', @HTTP_head, 1);
  rb_define_method(cHTTP, 'options', @HTTP_options, 1);
  rb_define_method(cHTTP, 'post', @HTTP_post, 2);
  rb_define_method(cHTTP, 'put', @HTTP_put, 2);
  rb_define_method(cHTTP, 'trace', @HTTP_trace, 2);
  DefineAttrGet(cHTTP, 'header_info', HTTP_get_header_info);
  DefineAttrGet(cHTTP, 'send_header', HTTP_get_send_header);
  DefineAttrSet(cHTTP, 'send_header', HTTP_set_send_header);

  rb_define_singleton_method(cHTTP, 'new', @HTTP_new, 0);
  DefineMethod(cHTTP, 'on_redirect', retval);

  rb_iv_set(cHTTP, '@events', rb_hash_new);
  DefineModuleAttrMethod(cHTTP, 'on_redirect');
end;

exports
  Init_http;

end.
