lazarus-ccr/wst/trunk/config_objects.pas

{
    This file is part of the Web Service Toolkit
    Copyright (c) 2006 by Inoussa OUEDRAOGO

    This file is provide under modified LGPL licence
    ( the files COPYING.modifiedLGPL and COPYING.LGPL).


    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}

{$INCLUDE wst_global.inc}
unit config_objects;

interface
uses SysUtils, Classes, base_service_intf, wst_types;

type

  TwstConfigItem = class(TBaseComplexRemotable);

  TwstConfigService = class(TwstConfigItem)
  private
    FPooled: Boolean;
    FPoolMax: PtrInt;
    FPoolMin: PtrInt;
    FTimeOut: PtrUInt;
    FName: string;
  public
    function GetConfigText() : string;
  published
    property Name : string read FName write FName;
    property PoolMax : PtrInt read FPoolMax write FPoolMax;
    property PoolMin : PtrInt read FPoolMin write FPoolMin;
    property Pooled : Boolean read FPooled write FPooled;
    property TimeOut : PtrUInt read FTimeOut write FTimeOut;
  end;

  TwstConfigServiceArray = class(TBaseObjectArrayRemotable)
  private
    function GetItem(AIndex: Integer): TwstConfigService;
  public
    class function GetItemClass():TBaseRemotableClass;override;
    property Item[AIndex:Integer] : TwstConfigService Read GetItem;Default;
  end;

  TWstConfigurationObject = class(TBaseComplexRemotable)
  private
    FServices: TwstConfigServiceArray;
  public
    constructor Create();override;
    destructor Destroy();override;
  published
    property Services : TwstConfigServiceArray read FServices write FServices;
  end;


  {$IFNDEF FPC}
  function GetAppConfigDir(const AGlobal : Boolean) : string;
  {$ENDIF}

  function wst_GetConfigFileName():string;
  function wst_GetConfigObject() : TWstConfigurationObject;
  function wst_GetServiceConfig(const AName : string) : TwstConfigService ;
  function wst_GetServiceConfigText(const AName : string) : string ;
  procedure wst_CreateDefaultFile();overload;
  procedure wst_CreateDefaultFile(const AFileName : string);overload;
  procedure wst_CreateDefaultFile(ADest : TStream; AConfigObj : TWstConfigurationObject);overload;
  procedure wst_CreateDefaultFile(const AFileName : string; AConfigObj : TWstConfigurationObject);overload;

implementation
uses
  base_soap_formatter, server_service_intf
{$IFNDEF FPC}
  , xmldom, wst_delphi_xml
{$ENDIF};

const
  sCONFIG_FILE_NAME = 'wst_config.xml';
  sAPPLICATION = 'Application';
  sWST_CONFIG_PATH = 'WST_Configuration';
var
  ConfigurationObjectInstance : TWstConfigurationObject = nil;

{$IFNDEF FPC}
function GetAppConfigDir(const AGlobal : Boolean) : string;
begin
  Result := ExtractFilePath(ParamStr(0));
end;

function GetAppConfigFile(const AGlobal : Boolean) : string;
begin
  Result := ChangeFileExt(ParamStr(0),'.xml');
end;
{$ENDIF}

function wst_GetConfigFileName():string;
begin
{$IFDEF WINDOWS}
  Result := ChangeFileExt(ParamStr(0),'.' + sCONFIG_FILE_NAME);
{$ELSE}
  Result := ChangeFileExt(GetAppConfigFile(False,True),'.' + sCONFIG_FILE_NAME);
{$ENDIF WINDOWS}
end;

procedure wst_LoadConfigObject(AConfig: TWstConfigurationObject; AStream : TStream);overload;
var
  frmt : IFormatterBase;
  locPrmName : string;
begin
  frmt := TSOAPBaseFormatter.Create();
  frmt.LoadFromStream(AStream);
  frmt.SetSerializationStyle(ssNodeSerialization);
  locPrmName := sWST_CONFIG_PATH;
  frmt.Get(TypeInfo(TWstConfigurationObject),locPrmName,AConfig);
end;

procedure wst_LoadConfigObject(AConfig : TWstConfigurationObject; const AFileName : string);overload;
var
  locStream : TMemoryStream;
begin
  if not FileExists(AFileName) then
    raise Exception.CreateFmt('File not found : "%s".',[AFileName]);
  locStream := TMemoryStream.Create();
  try
    locStream.LoadFromFile(AFileName);
    locStream.Position := 0;
    wst_LoadConfigObject(AConfig,locStream);
  finally
    FreeAndNil(locStream);
  end;
end;

function wst_CreateDefaultConfigObject() : TWstConfigurationObject;
var
  c, i : Integer;
  servReg : IServerServiceRegistry;
begin
  Result := TWstConfigurationObject.Create();
  try
    servReg := GetServerServiceRegistry();
    c := servReg.GetCount();
    Result.Services.SetLength(0);
    if ( c > 0 ) then begin
      Result.Services.SetLength(c);
      for i := 0 to Pred(c) do begin
        Result.Services[i].Name := servReg.GetName(i);
      end;
    end;
  except
    FreeAndNil(Result);
    raise;
  end;
end;

procedure wst_CreateDefaultFile();
begin
  wst_CreateDefaultFile(wst_GetConfigFileName());
end;

procedure wst_CreateDefaultFile(const AFileName : string);
begin
  wst_CreateDefaultFile(AFileName,nil);
end;

procedure wst_CreateDefaultFile(ADest : TStream; AConfigObj : TWstConfigurationObject);overload;
var
  locObj : TWstConfigurationObject;
  frmt : IFormatterBase;
  createdHere : Boolean;
begin
  createdHere := ( AConfigObj = nil );
  if ( AConfigObj <> nil ) then
    locObj := AConfigObj
  else
    locObj := wst_CreateDefaultConfigObject();
  try
    frmt := TSOAPBaseFormatter.Create();
    frmt.SetSerializationStyle(ssNodeSerialization);
    frmt.BeginObject(sAPPLICATION,TypeInfo(TWstConfigurationObject));
      frmt.Put(sWST_CONFIG_PATH,TypeInfo(TWstConfigurationObject),locObj);
    frmt.EndScope();
    frmt.SaveToStream(ADest);
  finally
    if createdHere then
      FreeAndNil(locObj);
  end;
end;

procedure wst_CreateDefaultFile(const AFileName : string; AConfigObj : TWstConfigurationObject);overload;
var
  locStream : TMemoryStream;
begin
  locStream := TMemoryStream.Create();
  try
    wst_CreateDefaultFile(locStream,AConfigObj);
    locStream.SaveToFile(AFileName);
  finally
    FreeAndNil(locStream);
  end;
end;

function wst_GetConfigObject() : TWstConfigurationObject;
var
  locFileName : string;
begin
  if ( ConfigurationObjectInstance = nil ) then begin
    ConfigurationObjectInstance := wst_CreateDefaultConfigObject();
    locFileName := wst_GetConfigFileName();
    if FileExists(locFileName) then
      wst_LoadConfigObject(ConfigurationObjectInstance,locFileName)
    {else
      wst_CreateDefaultFile(locFileName,ConfigurationObjectInstance);}
  end;
  Result := ConfigurationObjectInstance;
end;

function wst_GetServiceConfig(const AName : string) : TwstConfigService ;
var
  i, c : Integer;
  servs : TwstConfigServiceArray;
begin
  Result := nil;
  servs := wst_GetConfigObject().Services;
  c := servs.Length;
  for i := 0 to Pred(c) do begin
    if AnsiSameText(AName,servs[i].Name) then begin
      Result := servs[i];
      Break;
    end;
  end;
end;

function wst_GetServiceConfigText(const AName : string) : string ;
var
  s : TwstConfigService;
begin
  s := wst_GetServiceConfig(AName);
  if ( s <> nil ) then
    Result := s.GetConfigText()
  else
    Result := '';
end;

{ TwstConfigServiceArray }

function TwstConfigServiceArray.GetItem(AIndex: Integer): TwstConfigService;
begin
  Result := Inherited GetItem(AIndex) As TwstConfigService;
end;

class function TwstConfigServiceArray.GetItemClass() : TBaseRemotableClass;
begin
  Result := TwstConfigService;
end;

{ TWstConfigurationObject }

constructor TWstConfigurationObject.Create;
begin
  inherited;
  FServices := TwstConfigServiceArray.Create();
end;

destructor TWstConfigurationObject.Destroy;
begin
  FreeAndNil(FServices);
  inherited;
end;

{ TwstConfigService }

function TwstConfigService.GetConfigText() : string;
begin
  Result := Format('PoolMin=%d;PoolMax=%d;Pooled=',[PoolMin,PoolMax]);
  if Pooled then
    Result := Result + 'True'
  else
    Result := Result + 'False';
end;

procedure initialize_config_objects();
begin
  TwstConfigService.RegisterAttributeProperty('Name');
  GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TwstConfigService),'Service');
  GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TwstConfigServiceArray),'Services');
  GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TWstConfigurationObject),'WST_Configuration');
  GetTypeRegistry().ItemByTypeInfo[TypeInfo(TwstConfigServiceArray)].RegisterExternalPropertyName('Item','service');
end;

procedure finalize_config_objects();
begin
  {if ( ConfigurationObjectInstance <> nil ) and
     ( GetServerServiceRegistry.GetCount() <> ConfigurationObjectInstance.Services.Length )
  then begin
    wst_CreateDefaultFile(wst_GetConfigFileName(),nil);
  end;}
  FreeAndNil(ConfigurationObjectInstance);
end;

initialization
  initialize_config_objects();
  
finalization
  finalize_config_objects();
  
end.