Componentes.Terceros.RemObjects/official/5.0.24.615/Data Abstract for Delphi/Source/uDAPSScriptingProvider.pas

unit uDAPSScriptingProvider;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses
  Classes,
  uDAScriptingProvider, uDAInterfaces, uDABusinessProcessor, uDADataTable,
  uPSComponent, uDAPascalScript,
  uPSComponent_DB, uPSComponent_Default;

type
  TDAPSScriptingProvider = class;
  TDAPSScript = class(TPSScript)
  private
    fProvider: TDAPSScriptingProvider;
  protected
    function  DoOnGetNotificationVariant (const Name: string): Variant; override;
    procedure DoOnSetNotificationVariant (const Name: string; V: Variant); override;
    procedure DoOnCompile; override;
  end;
  TDAPSScriptingProvider = class(TDAScriptingProvider, IDADataTableScriptingProvider, IDABusinessProcessorScriptingProvider)
  private
    fDataTablePlugin: TDAPSDataTableRulesPlugin;
    fBusinessProcessor: TDABusinessProcessor;
    fDataTable: TDADataTable;
    fScript: TPSScript;
    fPluginClasses: TPSImport_Classes;
    fPluginDB: TPSImport_DB;
    fPluginDateUtils: TPSImport_DateUtils;

    procedure RunDataTableScript(aDataTable: TDADataTable; const aScript: string; const aMethod: string; aLanguage:TROSEScriptLanguage);
    procedure RunBusinessProcessorScript(aBusinessProcessor: TDABusinessProcessor; const aScript: string; const aMethod: string; aLanguage:TROSEScriptLanguage);

    procedure OnCompile(Sender: TPSScript);
    function OnGetNotificationVariant(Sender: TPSScript; const Name: string): Variant;
    procedure OnSetNotificationVariant(Sender: TPSScript; const Name: string; V: Variant);

    //procedure OnVerifyProc(Sender: TPSScript; Proc: TPSInternalProcedure; const Decl: string; var Error: Boolean);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure PrepareForDataTable(aDataTable: TDADataTable);
    procedure PrepareForBusinessProcessor(aBusinessProcessor: TDABusinessProcessor);

  published
    property ScriptEngine: TPSScript read fScript;
    property PluginClasses: TPSImport_Classes read fPluginClasses;
    property PluginDB: TPSImport_DB read fPluginDB;
    property PluginDateUtils: TPSImport_DateUtils read fPluginDateUtils;
  end;

implementation

uses
  SysUtils, uROClasses;

{ TDADataTableScripter }

constructor TDAPSScriptingProvider.Create(AOwner: TComponent);
begin
  inherited;
  fScript := TDAPSScript.Create(self);
  TDAPSScript(fScript).fProvider := Self;
  fScript.Name := 'ScriptEngine';
  fScript.SetSubComponent(true);
  //fScript.OnVerifyProc := OnVerifyProc;
  fScript.CompilerOptions := [icAllowNoBegin, icAllowNoEnd, icBooleanShortCircuit];
  fPluginClasses := TPSImport_Classes.Create(self);
  fPluginClasses.Name := 'PluginClasses';
  fPluginDB := TPSImport_DB.Create(self);
  fPluginDB.Name := 'PluginDB';
  fPluginDateUtils := TPSImport_DateUtils.Create(self);
  fPluginDateUtils.Name := 'PluginDateUtils';
  (fScript.Plugins.Add() as TPSPluginItem).Plugin := fPluginClasses;
  (fScript.Plugins.Add() as TPSPluginItem).Plugin := fPluginDB;
  (fScript.Plugins.Add() as TPSPluginItem).Plugin := fPluginDateUtils;
end;

destructor TDAPSScriptingProvider.Destroy;
begin
  FreeAndNil(fScript);
  inherited;
end;

procedure TDAPSScriptingProvider.OnCompile(Sender: TPSScript);
var
  i: Integer;
begin
  if Assigned(fDataTable) then begin
    for i := 0 to fDataTable.Fields.Count-1 do begin
      fScript.AddRegisteredVariable(fDataTable.Fields[i].Name, '!NOTIFICATIONVARIANT');
    end; { for }
  end;

  if Assigned(fBusinessProcessor) then begin
    //ToDo:
  end;
end;

{procedure TDAPSScriptingProvider.OnVerifyProc(Sender: TPSScript; Proc: TPSInternalProcedure; const Decl: string; var Error: Boolean);
begin
  if Proc.Decl.ParamCount = 0 then
    Proc.aExport := etExportDecl;
end;}

function TDAPSScriptingProvider.OnGetNotificationVariant(Sender: TPSScript; const Name: string): Variant;
begin
  result := fDataTable.Fields.FieldByName(Name).Value;
end;

procedure TDAPSScriptingProvider.OnSetNotificationVariant(Sender: TPSScript; const Name: string; V: Variant);
begin
  fDataTable.Fields.FieldByName(Name).Value := V;
end;

procedure TDAPSScriptingProvider.PrepareForBusinessProcessor(aBusinessProcessor: TDABusinessProcessor);
begin

end;

procedure TDAPSScriptingProvider.PrepareForDataTable(aDataTable: TDADataTable);
begin
  fDataTable := aDataTable;
  fBusinessProcessor := nil;
  fScript.Defines.Text := 'DATA_ABSTRACT_SCRIPT'#13#10'DATA_ABSTRACT_SCRIPT_CLIENT';
  if not assigned(fDataTablePlugin) then begin
    fDataTablePlugin := TDAPSDataTableRulesPlugin.Create(self);
    fDataTablePlugin.DataTable := aDataTable;
    (fScript.Plugins.Add() as TPSPluginItem).Plugin := fDataTablePlugin;
  end;
end;


procedure TDAPSScriptingProvider.RunBusinessProcessorScript(
  aBusinessProcessor: TDABusinessProcessor; const aScript, aMethod: string;
  aLanguage: TROSEScriptLanguage);
begin
  fDataTable := nil;
  FreeAndNil(fDataTablePlugin);
  fBusinessProcessor := aBusinessProcessor;
  fScript.Defines.Text := 'DATA_ABSTRACT_SCRIPT'#13#10'DATA_ABSTRACT_SCRIPT_SERVER';
  //(fScript.Plugins.Add() as TPSPluginItem).Plugin := TDAPSDataTableRulesPlugin.Create(self);
end;

type
  TScriptMethod = procedure of object;

procedure TDAPSScriptingProvider.RunDataTableScript(aDataTable: TDADataTable; const aScript, aMethod: string; aLanguage: TROSEScriptLanguage);
var
  lMessages: string;
  i: Integer;
  lMethod: TScriptMethod;
begin
  if fDataTable <> aDataTable then begin
    PrepareForDataTable(aDataTable);
  end;
  if aScript <> fScript.Script.Text then begin
    fScript.Script.Text := aScript;
    if not fScript.Compile then begin
      lMessages := '';
      for i := 0 to fScript.CompilerMessageCount-1 do begin
        lMessages := lMessages+#13#10+fScript.CompilerMessages[i].MessageToString;
      end; { for }
      RaiseError('There were errors compiling the business rule script for %s.'#13+lMessages,[aDataTable.Name], EDAScriptCompileError);
    end;
  end;

  fDataTablePlugin.DataTable := aDataTable;
  lMethod := TScriptMethod(fScript.GetProcMethod(aMethod));
  if assigned(@lMethod) then
    lMethod();
end;

{ TDAPSScript }

procedure TDAPSScript.DoOnCompile;
begin
  inherited;
  fProvider.OnCompile(Self);
end;

function TDAPSScript.DoOnGetNotificationVariant(
  const Name: string): Variant;
begin
  Result := fProvider.OnGetNotificationVariant(Self, Name);
end;

procedure TDAPSScript.DoOnSetNotificationVariant(const Name: string;
  V: Variant);
begin
  fProvider.OnSetNotificationVariant(Self, Name, V);
end;

end.