source: trunk/Application/WebSession.pas

unit WebSession;

interface

uses
  Classes, SysUtils, HTTPServer, SqlDatabase, HTTPSessionMySQL, User,
  HtmlClasses, WebPage, Utils, XmlClasses, DateUtils, ModularSystem,
  PageList, WebApp, Generics;

type

  { TWebSession }

  TWebSession = class(THTTPHandlerData)
  private
    procedure GeneratePageDefault(ASession: TWebSession; Page: TWebPage);
    procedure RegisterModules;
    procedure CheckModules;
  public
    MainModule: TObject;
    Database: TSqlDatabase;
    SessionStorage: THTTPSessionStorageMySQL;
    HtmlDocument: THtmlDocument;
    GlobalTitle: string;
    TimeStart: TDateTime;
    BaseURL: string;
    ModuleManager: TModuleManager;
    procedure PageNotFound;
    procedure InitDatabase;
    constructor Create; override;
    destructor Destroy; override;
    procedure GeneratePage(Page: TWebPage);
    procedure Run;
  end;


implementation

uses
  Core, ModuleSystem, ModuleZdechovNET, ModuleUser, PageAdmin, ModuleTV,
  ModuleFinance, ModuleNetwork, ModulePortal, ModuleIS, ModuleBase,
  ModuleNews, PageNotFound;

resourcestring
  SError = '<div>Error: %s</div>';

{ TWebSession }

constructor TWebSession.Create;
begin
  inherited;
  ModuleManager := TModuleManager.Create(nil);
  Database := TSqlDatabase.Create(nil);
  SessionStorage := THTTPSessionStorageMySQL.Create(nil);
  SessionStorage.Database := Database;
  HtmlDocument := THtmlDocument.Create;
end;

destructor TWebSession.Destroy;
begin
  ModuleManager.StopAll;
  FreeAndNil(ModuleManager);
  FreeAndNil(HtmlDocument);
  FreeAndNil(SessionStorage);
  FreeAndNil(Database);
  inherited;
end;

procedure TWebSession.GeneratePage(Page: TWebPage);
begin
  with TModuleBase(ModuleManager.FindModuleByName('Base')) do
  if Assigned(OnGeneratePage) then OnGeneratePage(Self, Page)
    else GeneratePageDefault(Self, Page);
end;

procedure TWebSession.Run;
var
  FileName: string;
  PageName: string;
  Page: TRegistredPage;
  BaseUrlParts: TListString;
  ModuleBase: TModuleBase;
begin
  RegisterModules;
  CheckModules;
  ModuleManager.StartInstalled;

  try
    BaseUrlParts := TListString.Create;
    BaseUrlParts.Explode('/', BaseURL);
    while (BaseUrlParts.Count > 0) and (Request.Path.Count > 0) and
      (BaseUrlParts[0] = Request.Path[0]) do begin
        BaseUrlParts.Delete(0);
        Request.Path.Delete(0);
      end;
  finally
    BaseUrlParts.Free;
  end;
  if Request.Path.Count > 0 then PageName := Request.Path[0]
    else PageName := '';
  ModuleBase := TModuleBase(ModuleManager.FindModuleByName('Base'));
  Page := ModuleBase.Pages.FindByName(PageName);
  if Assigned(Page) then begin
    try
      if Assigned(Page.Page) then Page.Page.OnProduce(Self);
    except
      on E: Exception do begin
        Self.HtmlDocument.Body.SubItems.AddString.Text := Format(SError, [E.Message]);
        GeneratePage(Page.Page);
      end;
    end;
  end else begin
    Core.Core.WebApp1.HTTPServer.FileResponse(Self)
  end;
end;

procedure TWebSession.GeneratePageDefault(ASession: TWebSession; Page: TWebPage);
var
  I: Integer;
begin
  with ASession do begin
    HtmlDocument.ContentLanguage := 'cs';
    GlobalTitle := 'WebSystem';

    //Page.Page.OnProduce(HandlerData);
    HtmlDocument.Title := Page.Caption;
    with HtmlDocument.AsXmlDocument do
    try
      Formated := TCore(MainModule).FormatHTML;
      Response.Content.WriteString(AsString);
    finally
      Free;
    end;
  end;
end;

procedure TWebSession.InitDatabase;
var
  DbRows: TDbRows;
begin
  with Database do begin
    Encoding := 'utf8';
    Connect;
  end;
end;

procedure TWebSession.RegisterModules;
var
  ModuleBase: TModuleBase;
begin
  with ModuleManager do begin
    RegisterModule(TModuleSystem.Create(nil), True);
    RegisterModule(TModuleBase.Create(nil), True);
    RegisterModule(TModuleUser.Create(nil), True);
    RegisterModule(TModuleZdechovNET.Create(nil), True);
    RegisterModule(TModuleTV.Create(nil), True);
    RegisterModule(TModuleFinance.Create(nil), True);
    RegisterModule(TModuleNetwork.Create(nil), True);
    //RegisterModule(TModulePortal.Create(nil), True);
    RegisterModule(TModuleIS.Create(nil), True);
    RegisterModule(TModuleNews.Create(nil), True);

    ModuleBase := TModuleBase(ModuleManager.FindModuleByName('Base'));
    if Assigned(ModuleBase) then ModuleBase.Session := Self;
    if Assigned(ModuleBase) then ModuleBase.HandlerData := Self;
  end;
end;

procedure TWebSession.CheckModules;
var
  DbRows: TDbRows;
  Module: TModule;
  I: Integer;
begin
  try
    DbRows := TDbRows.Create;
    Database.Query(DbRows, 'SELECT * FROM INFORMATION_SCHEMA.TABLES ' +
      'WHERE TABLE_SCHEMA = "' + Database.Database + '" AND TABLE_NAME = "SystemModule"');
    Module := ModuleManager.FindModuleByName('System');
    if DbRows.Count > 0 then Module.SetInstalledState(True)
      else Module.SetInstalledState(False);
  finally
    DbRows.Free;
  end;

  // Set all modules to already installed state
  for I := 0 to ModuleManager.Modules.Count - 1 do
    TModule(ModuleManager.Modules[I]).SetInstalledState(True);
end;

procedure TWebSession.PageNotFound;
var
  Page: TPageNotFound;
begin
  Page := TPageNotFound.Create(nil);
  try
    if Assigned(Page.OnProduce) then
      Page.OnProduce(Self);
  finally
    Page.Free;
  end;
end;


end.