unit DASampleService_Impl;

interface

uses
  {vcl:} Classes, SysUtils,
  {RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions, uRORemoteDataModule,
  {Data Abstract:} uDAClasses, uDADataTable, uDABin2DataStreamer, uDAInterfaces, uDABusinessProcessor,
  {Ancestor Implementation:} DataAbstractService_Impl,
  {Used RODLs:} DataAbstract4_Intf,
  {Generated:} DASampleLibrary_Intf, uROClient, uDADataStreamer,
  uDAScriptingProvider, uDADelta;

type
  { TDASampleService }
  TDASampleService = class(TDataAbstractService, IDASampleService)
    DataStreamer: TDABin2DataStreamer;
    bpBPWorkers: TDABusinessProcessor;
    bpBPClients: TDABusinessProcessor;
    bpBPProviders: TDABusinessProcessor;
    bpClients: TDABusinessProcessor;
    bpDealers: TDABusinessProcessor;
    bpGroups: TDABusinessProcessor;
    bpOrderDetails: TDABusinessProcessor;
    bpOrders: TDABusinessProcessor;
    bpPrices: TDABusinessProcessor;
    bpProducts: TDABusinessProcessor;
    bpProviders: TDABusinessProcessor;
    bpSellers: TDABusinessProcessor;
    bpWorkers: TDABusinessProcessor;
    Schema: TDASchema;
    procedure DataAbstractServiceValidateDatasetAccess(Sender: TObject;
      const aConnection: IDAConnection; const aDatasetName: string;
      const aParamNames: array of string; const aParamValues: array of Variant;
      aSchema: TDASchema; var Allowed: Boolean);
    procedure DataAbstractServiceValidateCommandExecution(Sender: TObject;
      const aConnection: IDAConnection; const aDatasetName: string;
      const aParamNames: array of string; const aParamValues: array of Variant;
      aSchema: TDASchema; var Allowed: Boolean);
    procedure DataAbstractServiceBeforeExecuteCommand(aSender: TObject;
      const aCommand: IDASQLCommand);
    procedure SchemaGetSQL(Sender: TDASchema; const ElementName: string;
      ElementType: TDASchemaElementType; var SQL: string);
    procedure DataAbstractServiceAfterGetDatasetData(aSender: TObject;
      const aDataset: IDADataset; const aIncludeSchema: Boolean;
      const aMaxRecords: Integer);
    procedure bpBPClientsBeforeProcessChange(Sender: TDABusinessProcessor;
      aChangeType: TDAChangeType; aChange: TDADeltaChange;
      var ProcessChange: Boolean);
    procedure DataAbstractServiceBeforeProcessDeltas(aSender: TObject;
      aDeltaStructs: TDADeltaStructList);
    procedure DataAbstractServiceAfterProcessDeltas(aSender: TObject;
      aDeltaStructs: TDADeltaStructList);
    procedure DataAbstractServiceValidateDirectSQLAccess(Sender: TObject;
      const aConnection: IDAConnection; const aSQLText: string;
      const aParamNames: array of string; const aParamValues: array of Variant;
      var Allowed: Boolean);
    procedure BusinessProcessorGenerateSQL(Sender: TDABusinessProcessor;
      ChangeType: TDAChangeType; const ReferencedStatement: TDAStatement;
      const aDelta: IDADelta; var SQL: string);
    procedure BusinessProcessorBeforeProcessDelta(Sender: TDABusinessProcessor;
      const aDelta: IDADelta);
  private
    function ChangeTypeToString(aChangeType: TDAChangeType): string;
    procedure DescribeMapping(aMappings: TDAColumnMappingCollection);
    procedure DescribeDeltaChange(aChange: TDADeltaChange);
    function ShowEmptyNull(aValue: Variant): string;
    function GetBPProvidersCustomSQL(aChangeType: TDAChangeType): string;
  protected
    { IDASampleService methods }
    procedure Login(const aPlatform: PlatformEnum; const aName: Widestring);
    procedure BlockRow(const pkField: AnsiString);
    procedure UnblockRow(const pkField: AnsiString; const IsReadRow: Boolean);
    procedure BlockSetOfRows;
    procedure Subscribe(const aSubscribe: Boolean);
  end;

implementation

{$R *.dfm}
uses
  {Generated:} DASampleLibrary_Invk, fServerDataModule, fServerForm, uROClasses,
  Variants, uDAEngine;

procedure Create_DASampleService(out anInstance: IUnknown);
begin
  anInstance := TDASampleService.Create(nil);
end;

var
  fClassFactory: IROClassFactory;

procedure TDASampleService.BlockRow(const pkField: AnsiString);
var
  ev: IUpdateEvent_Writer;
begin
  with ServerDataModule do
    if BlockedRows.IndexOf(AnsiStringToWideString(pkField)) < 0
    then BlockedRows.Add(AnsiStringToWideString(pkField));
  ev := EventRepository as IUpdateEvent_Writer;
  ev.ExcludeSender := true;
  ev.OnUpdateBlock(ClientID, pkField, GUIDToString(ClientID));
end;

procedure TDASampleService.BlockSetOfRows;
var
  ev: IUpdateEvent_Writer;
  i: integer;
  arr: AnsiStringArray;
begin
  arr := AnsiStringArray.Create;
  with ServerDataModule do begin
    arr.Resize(BlockedRows.Count);
    for i := 0 to BlockedRows.Count - 1 do
      arr.Add(WideStringToAnsiString(BlockedRows.Strings[i]));
  end;
  ev := EventRepository as IUpdateEvent_Writer;
  ev.ExcludeSender := false;
  ev.OnUpdateAllBlock(ClientID, arr);
  arr.Free;
end;

procedure TDASampleService.bpBPClientsBeforeProcessChange(
  Sender: TDABusinessProcessor; aChangeType: TDAChangeType;
  aChange: TDADeltaChange; var ProcessChange: Boolean);
var
  discount: double;
begin
  ServerForm.LogMessage(#9'Checking business rules for Clients dataset');

  if aChangeType = ctDelete then begin
    ServerForm.LogMessage(#9#9'Forbiding to delete the client "' +
      VarToStr(aChange.OldValueByName['Name']) + '"');
    raise EDAException.Create('Client deletion is forbiden!');
  end;

  discount := aChange.NewValueByName['Discount'];
  if (discount < 0.0) or (discount > 50.0) then begin
    ServerForm.LogMessage(#9#9'Forbiding discount out of [0;50] range: ' +
      FloatToStr(discount));
    raise EDAException.Create('Discount out of range!');
  end;
end;

procedure TDASampleService.BusinessProcessorBeforeProcessDelta(
  Sender: TDABusinessProcessor; const aDelta: IDADelta);
var
  i: integer;
begin
  ServerForm.LogMessage(#9'Preparing to process delta to the dataset: ' + aDelta.LogicalName);
  ServerForm.LogMessage(#9#9'Changes count: ' + IntToStr(aDelta.Count));
  ServerForm.LogMessage(' ');
  for i := 0 to aDelta.Count - 1 do begin
    ServerForm.LogMessage(#9'Delta change #' + IntToStr(i + 1) + ', change type: ' +
      ChangeTypeToString(aDelta.Changes[i].ChangeType));
    ServerForm.LogMessage(#9'---------------');
    DescribeDeltaChange(aDelta.Changes[i]);
  end;
  ServerForm.LogMessage(' ');
end;

procedure TDASampleService.BusinessProcessorGenerateSQL(
  Sender: TDABusinessProcessor; ChangeType: TDAChangeType;
  const ReferencedStatement: TDAStatement; const aDelta: IDADelta;
  var SQL: string);
begin
  ServerForm.LogMessage(#9'Column mappings');
  ServerForm.LogMessage(#9'---------------');
  DescribeMapping(ReferencedStatement.ColumnMappings);
  ServerForm.LogMessage(' ');
  if Sender = bpBPProviders then begin
    ServerForm.LogMessage(#9'Preparing CUSTOM SQL statement for BPProviders dataset:');
    SQL := GetBPProvidersCustomSQL(ChangeType);
  end
  else ServerForm.LogMessage(#9'Preparing SQL statement:');
  ServerForm.LogMessage(#9'------------------------');
  ServerForm.LogMessage(SQL);
  ServerForm.LogMessage(' ');
end;

function TDASampleService.ChangeTypeToString(
  aChangeType: TDAChangeType): string;
begin
  Result := '';
  case aChangeType of
    ctInsert: Result := 'Insert';
    ctUpdate: Result := 'Update';
    ctDelete: Result := 'Delete';
  end;
end;

procedure TDASampleService.DataAbstractServiceAfterGetDatasetData(
  aSender: TObject; const aDataset: IDADataset; const aIncludeSchema: Boolean;
  const aMaxRecords: Integer);
var
  s: string;
begin
  ServerForm.LogMessage(#9'Sending data to the client.');
  s := #9'Sending ';
  if aMaxRecords = -1 then s := s + 'all records'
  else s := s + IntToStr(aMaxRecords) + ' record(s)';
  ServerForm.LogMessage(s);
  s := #9'Sending schema: ';
  if aIncludeSchema then s := s + 'yes' else s := s + 'no';
  ServerForm.LogMessage(s);
  ServerForm.LogMessage(' ');
  ServerForm.LogMessage('Request completed');
  ServerForm.LogMessage('=================');
end;

procedure TDASampleService.DataAbstractServiceAfterProcessDeltas(
  aSender: TObject; aDeltaStructs: TDADeltaStructList);
begin
  ServerForm.LogMessage('Request completed');
  ServerForm.LogMessage('=================');
end;

procedure TDASampleService.DataAbstractServiceBeforeExecuteCommand(
  aSender: TObject; const aCommand: IDASQLCommand);
begin
  // TODO:
  ServerForm.LogMessage('DataAbstractServiceBeforeExecuteCommand');
end;

procedure TDASampleService.DataAbstractServiceBeforeProcessDeltas(
  aSender: TObject; aDeltaStructs: TDADeltaStructList);
begin
  ServerForm.LogMessage(' ');
  ServerForm.LogMessage(DateTimeToStr(Now) + ' - Going to process deltas');
  ServerForm.LogMessage(#9'Session ID: ' + GUIDToString(ClientID));
  ServerForm.LogMessage(#9'Deltas count: ' + IntToStr(aDeltaStructs.Count));
  ServerForm.LogMessage(' ');
end;

procedure TDASampleService.DataAbstractServiceValidateCommandExecution(
  Sender: TObject; const aConnection: IDAConnection; const aDatasetName: string;
  const aParamNames: array of string; const aParamValues: array of Variant;
  aSchema: TDASchema; var Allowed: Boolean);
begin
  // TODO:
  ServerForm.LogMessage('DataAbstractServiceValidateCommandExecution');
end;

procedure TDASampleService.DataAbstractServiceValidateDatasetAccess(
  Sender: TObject; const aConnection: IDAConnection; const aDatasetName: string;
  const aParamNames: array of string; const aParamValues: array of Variant;
  aSchema: TDASchema; var Allowed: Boolean);
var
  s: string;
begin
  ServerForm.LogMessage(' ');
  ServerForm.LogMessage(DateTimeToStr(Now) + ' - Dataset access requested');
  ServerForm.LogMessage(#9'Session ID: ' + GUIDToString(ClientID));
  ServerForm.LogMessage(#9'Dataset name: ' + aDatasetName);
  s := #9'Parameters: ';
  if Length(aParamNames) = 0 then s := s + 'none'
  else begin
    // TODO:
    s := s + 'some';
  end;
  ServerForm.LogMessage(s);
end;

procedure TDASampleService.DataAbstractServiceValidateDirectSQLAccess(
  Sender: TObject; const aConnection: IDAConnection; const aSQLText: string;
  const aParamNames: array of string; const aParamValues: array of Variant;
  var Allowed: Boolean);
begin
  // TODO:
  ServerForm.LogMessage('DataAbstractServiceValidateDirectSQLAccess');
end;

procedure TDASampleService.DescribeDeltaChange(aChange: TDADeltaChange);
var
  i: integer;
begin
  for i := 0 to aChange.Delta.LoggedFieldCount - 1 do
    ServerForm.LogMessage(#9 + aChange.Delta.LoggedFieldNames[i] + ': ' +
      ShowEmptyNull(aChange.OldValues[i]) + #9'->'#9 +
      ShowEmptyNull(aChange.NewValues[i]));
end;

procedure TDASampleService.DescribeMapping(aMappings: TDAColumnMappingCollection);
var
  i: integer;
begin
  for i := 0 to aMappings.Count - 1 do
    with aMappings[i] do
      ServerForm.LogMessage(#9'DatasetField: ' + DatasetField +
        ' TableField: ' + TableField + ' SQLOrigin:' + SQLOrigin);
end;

function TDASampleService.GetBPProvidersCustomSQL(aChangeType: TDAChangeType): string;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.Add('/* My Custom overridden SQL */');
  if Connection.ConnectionType = 'MSSQL' then
    case aChangeType of
      ctInsert: begin
        sl.Add('INSERT INTO [Suppliers]([Id], [Name], [Phone], [Address])');
        sl.Add('VALUES (:Id, :Name, :Phone, :Address)');
        end;
      ctUpdate: begin
        sl.Add('UPDATE [Suppliers] SET [Id] = :Id, [Name] = :Name, [Phone] = :Phone, [Address] = :Address');
        sl.Add('WHERE ([Id] = :OLD_Id)');
        end;
      ctDelete: sl.Add('DELETE FROM [Suppliers] WHERE ([Id] = :OLD_Id)');
    end
  else if Connection.ConnectionType = 'Interbase' then
    case aChangeType of
      ctInsert: begin
        sl.Add('INSERT INTO "SUPPLIERS" ("SUPP_ID", "SUPP_NAME", "SUPP_PHONE", "SUPP_ADDRESS")');
        sl.Add('VALUES (:Id, :Name, :Phone, :Address)');
        end;
      ctUpdate: begin
        sl.Add('UPDATE "SUPPLIERS" SET "SUPP_ID" = :Id, "SUPP_NAME" = :Name, "SUPP_PHONE" = :Phone, "SUPP_ADDRESS" = :Address');
        sl.Add('WHERE ("SUPP_ID" = :OLD_Id)');
        end;
      ctDelete: sl.Add('DELETE FROM "SUPPLIERS" WHERE ("SUPP_ID" = :OLD_Id)');
    end
  else if Connection.ConnectionType = 'SQLite' then
    case aChangeType of
      ctInsert: begin
        sl.Add('INSERT INTO "SUPPLIER" ("Id", "Name", "Phone", "Address")');
        sl.Add('VALUES (:Id, :Name, :Phone, :Address)');
        end;
      ctUpdate: begin
        sl.Add('UPDATE "SUPPLIER" SET "Id" = :Id, "Name" = :Name, "Phone" = :Phone, "Address" = :Address');
        sl.Add('WHERE ("Id" = :OLD_Id)');
        end;
      ctDelete: sl.Add('DELETE FROM "SUPPLIER" WHERE ("Id" = :OLD_Id)');
    end
  else raise Exception.Create('Unsupported connection name!');
  Result := sl.Text;
  sl.Free;
end;

procedure TDASampleService.Login(const aPlatform: PlatformEnum;
  const aName: Widestring);
begin
  // TODO: More info
  ServerForm.LogMessage('New client logged in: ' + aName);
end;

procedure TDASampleService.SchemaGetSQL(Sender: TDASchema;
  const ElementName: string; ElementType: TDASchemaElementType;
  var SQL: string);
begin
  ServerForm.LogMessage(' ');
  case ElementType of
    setDataset: begin
      ServerForm.LogMessage(#9'Executing SQL:');
      ServerForm.LogMessage(#9'--------------');
      ServerForm.LogMessage(SQL);
      end;
    setCommand: begin
      ServerForm.LogMessage(#9'Executing Schema command: ' + ElementName);
      ServerForm.LogMessage(SQL);
      end;
  end;
  ServerForm.LogMessage(' ');
end;

function TDASampleService.ShowEmptyNull(aValue: Variant): string;
begin
  if aValue = Null then Result := '<NULL>'
  else Result := VarToStr(aValue);
  if Result = '' then Result := '<EMPTY>';
end;

procedure TDASampleService.Subscribe(const aSubscribe: Boolean);
begin
  if aSubscribe then
    RegisterEventClient(WideStringToAnsiString(GUIDToString(ClientID)), EID_UpdateEvent)
  else UnregisterEventClient(WideStringToAnsiString(GUIDToString(ClientID)), EID_UpdateEvent);
end;

procedure TDASampleService.UnblockRow(const pkField: AnsiString;
  const IsReadRow: Boolean);
var
  ev: IUpdateEvent_Writer;
  i: integer;
begin
  with ServerDataModule do begin
    i := BlockedRows.IndexOf(AnsiStringToWideString(pkField));
    if i >= 0 then BlockedRows.Delete(i);
  end;

  ev := EventRepository as IUpdateEvent_Writer;
  ev.ExcludeSender := true;
  ev.OnUpdateUnblock(ClientID, pkField, GUIDToString(ClientID), true);
end;

initialization
  fClassFactory := TROClassFactory.Create('DASampleService', Create_DASampleService, TDASampleService_Invoker);
  RegisterForZeroConf(fClassFactory,'_DASampleService_rosdk._tcp.');
finalization
  UnRegisterClassFactory(fClassFactory);
  fClassFactory := nil;
end.