unit WebHandle;

interface

uses
  Windows, Classes, SyncObjs, SysUtils, Controls, Rubies, HTTPApp, HTTPProd;

type
  TWebHandle = class(TObject)
  private
    FCriticalSection: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure doDispatch(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean; name: PChar);
    procedure HTTPMethodBeforeDispatch(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure HTTPMethodAfterDispatch(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure HTMLTagOnHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string);
    property CriticalSection: TCriticalSection read FCriticalSection;
  end;

var
  cRequest,
  cResponse: Tvalue;

implementation

uses Pythia, uStrUtils, uModule, uRequest, uResponse;

constructor TWebHandle.Create;
begin
  inherited Create;
  FCriticalSection := TCriticalSection.Create;
end;

destructor TWebHandle.Destroy;
begin
  FCriticalSection.Free;
end;

procedure TWebHandle.doDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean; name: PChar);
var
  recv, data, ret: Tvalue;
begin
  FCriticalSection.Enter;
  try
    recv := TComponent(Sender).tag;
    data := rb_ary_new;
    rb_ary_push(data, rb_intern(name));
    rb_ary_push(data, recv);
    rb_ary_push(data, ap_bool(Handled));
    rb_ary_push(data, WebModule_get_request(recv));
    rb_ary_push(data, WebModule_get_response(recv));
    ret := PhiCallProtect(data);
    if ret <> Qnil then try Handled := dl_Boolean(ret) except Handled := True end;
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TWebHandle.HTTPMethodBeforeDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  doDispatch(Sender, Request, Response, Handled, 'before_dispatch');
end;

procedure TWebHandle.HTTPMethodAfterDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  doDispatch(Sender, Request, Response, Handled, 'after_dispatch');
end;

procedure TWebHandle.HTMLTagOnHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
  recv, data, ret: Tvalue;
begin
  FCriticalSection.Enter;
  try
    recv := TComponent(Sender).tag;
    data := rb_ary_new;
    rb_ary_push(data, rb_intern('on_html_tag'));
    rb_ary_push(data, recv);
    rb_ary_push(data, ap_String(ReplaceText));
    rb_ary_push(data, ap_Fixnum(Ord(Tag)));
    rb_ary_push(data, ap_String(TagString));
    rb_ary_push(data, ap_iStrings(TagParams, recv));
    ret := PhiCallProtect(data);
    if ret <> Qnil then
    case RTYPE(ret) of
    T_STRING:
      ReplaceText := dl_String(ret)
    else
      ReplaceText := dl_String(rb_inspect(ret));
    end;
  finally
    FCriticalSection.Leave;
  end;
end;

end.
