Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue52/HTML/Code/AppServer/svrSubmitHandler.pas

Pascal/Delphi Source File | 1999-10-26 | 6.0 KB | 204 lines

unit svrSubmitHandler;

interface

uses
  Classes, DBTables, SysUtils, dpoBase, mleCommon, usXMLDoc;

resourcestring
  SSubmitInvalidClassType = '%s is not a valid business object class';
  SSubmitNoBindingInfo = 'No binding information found for instance "%s"';
  SSubmitUnsupportedDatatype = 'Cannot assign value to "%s.%s"; unsupported datatype (%s)';

type
  ESubmitException = class(Exception);
  ESubmitInvalidClassType = class(ESubmitException);
  ESubmitNoBindingInfo = class(ESubmitException);
  ESubmitUnsupportedDatatype = class(ESubmitException);

type
  TProcessingInstruction = (piUndefined, piInsert, piUpdate, piDelete);

  TSubmitHandler = class(TComponent)
  protected
    Variables: TStrings;
    Database: TDatabase;
    Parser: TusXMLParser;
    DataBindings: TusXMLDocument;
    InstanceData: TusXMLElement;
    InstanceName: string;
    Instance: TDataObject;
    procedure CreateInstance(aInstanceName: string);
    function GetDataObjectClass(aClassName: string): TDataObjectClass;
    procedure SetInstanceProperties;
  public
    constructor Create(aOwner: TComponent; aPacket: TInfoPacket); reintroduce; virtual;
    destructor Destroy; override;
    function GetContent: string; virtual;
  end;

implementation

uses
  svrPageHandler;

{ TSubmitHandler }

constructor TSubmitHandler.Create(aOwner: TComponent; aPacket: TInfoPacket);
begin
  inherited Create(aOwner);
  Database := aPacket.Database;
  Variables := aPacket.Variables;
  Parser := TusXMLParser.Create;
end;

procedure TSubmitHandler.CreateInstance(aInstanceName: string);
var
  I: Integer;
  InstanceClass: TDataObjectClass;
begin
  InstanceName := aInstanceName;
  InstanceClass := nil;

  { Locate the data binding information for the instance }
  if not Assigned(DataBindings) then
    raise ESubmitNoBindingInfo.CreateFmt(SSubmitNoBindingInfo, [InstanceName]);

  { DataBindings points to the <DATABINDINGS> element }
  for I := 0 to DataBindings.Root.Subtags.Count - 1 do
  begin
    { InstanceData points to an <INSTANCE> element }
    InstanceData := DataBindings.Root.Subtags[I];
    with InstanceData do
    begin
      { <INSTANCE class="xxx" oid="xxx" name="xxx"> }
      if CompareText(Attributes.Value('name'), InstanceName) = 0 then
      begin
        { transform class name into class type }
        InstanceClass := GetDataObjectClass(Attributes.Value('class'));
        if not Assigned(InstanceClass) then
          raise ESubmitInvalidClassType.CreateFmt(SSubmitInvalidClassType, [Attributes.Value('class')]);

        { Instantiate the data object }
        Instance := InstanceClass.Create(Database);

        { Load the data object with data }
        Instance.GetByOID(Attributes.Value('oid'));

        Break;
      end;
    end;
  end;

  if not Assigned(InstanceClass) then
    raise ESubmitNoBindingInfo.CreateFmt(SSubmitNoBindingInfo, [InstanceName]);
end;

destructor TSubmitHandler.Destroy;
begin
  Parser.Free;
  inherited;
end;

function TSubmitHandler.GetContent: string;
var
  I: Integer;
  ProcessingInstruction: TProcessingInstruction;
begin
  Result := '';

  Parser.LoadXML(Variables.Values['SMLDataBindings']);
  DataBindings := Parser.Document;

  { Find all the processing instructions that were passed in as URL parameters. }
  with Variables do
  begin
    for I := 0 to Count - 1 do
    begin
      ProcessingInstruction := piUndefined;
      if (CompareText(Names[I], 'pi:update') = 0) then
        ProcessingInstruction := piUpdate;
      if (CompareText(Names[I], 'pi:insert') = 0) then
        ProcessingInstruction := piInsert;
      if (CompareText(Names[I], 'pi:delete') = 0) then
        ProcessingInstruction := piDelete;

      { Processing only continues when we've found a processing instruction }
      if ProcessingInstruction = piUndefined then
        Continue;

      CreateInstance(Values[Names[I]]);
      try
        case ProcessingInstruction of
          piUpdate,
          piInsert: SetInstanceProperties;
          piDelete: Instance.Delete;
        end;
      finally
      end;
    end;
  end;
end;

function TSubmitHandler.GetDataObjectClass(aClassName: string): TDataObjectClass;
var
  AClass: TClass;
begin
  Result := nil;
  AClass := GetClass(aClassName);
  if Assigned(AClass) then
    if AClass.InheritsFrom(TDataObject) then
      Result := TDataObjectClass(AClass)
end;

procedure TSubmitHandler.SetInstanceProperties;
var
  I, J: Integer;
  BindingData: TusXMLElement;
  ControlName: string;
  PropertyName: string;
  NewValue: string;
begin
  { For each property specified in the binding information, find its current
    value in the variable list and set the applicable data object property. }
  BindingData := nil;
  with InstanceData.Subtags do
  begin
    { Find the <BINDINGS> tag }
    for I := 0 to Count - 1 do
      if CompareText(Items[I].TagName, 'bindings') = 0 then
      begin
        BindingData := Items[I];
        Break;
      end;
    if not Assigned(BindingData) then
      raise ESubmitNoBindingInfo.CreateFmt(SSubmitNoBindingInfo, [InstanceName]);

    { Loop though all the property assignments for this instance }
    { Each subtag of <BINDINGS> is a <BINDING> tag, so look for subtags
      under <BINDING> }
    for I := 0 to BindingData.Subtags.Count - 1 do
    begin  { a <BINDING> tag }
      with BindingData.Subtags[I].Subtags do
        for J := 0 to Count - 1 do
        begin  { a subtag under <BINDING> }
          if CompareText(Items[J].TagName, 'property') = 0 then
            PropertyName := Items[J].Data;
          if CompareText(Items[J].TagName, 'control') = 0 then
            ControlName := Items[J].Data;
        end;

      if Variables.IndexOfName(ControlName) <> -1 then
      begin
        NewValue := Variables.Values[ControlName];
        Instance.EditMode;
        Instance.PropertyByName(PropertyName).AsVariant := NewValue;
      end;
    end;
    if Instance.Modified then
      Instance.Save;
  end;
end;

end.