unit uBizContactosServer;

interface

uses
  SysUtils, schContactosServer_Intf, uDAInterfaces,
  uDADataTable, uDABusinessProcessor, uDADelta;

const
  BIZ_SERVER_CONTACTO = 'Server.Contacto';

type
  TBizContactosServer = class(TContactosBusinessProcessorRules)
  private
    FReferenciaAutomatica : Boolean;
  protected
    function _DarReferenciaInterna(const ATipo: String) : String;
    function _IncrementarReferenciaInterna(const ATipo: String) : Boolean;

    function DarReferenciaContacto : String; virtual; abstract;
    function IncrementarReferenciaContacto : Boolean; virtual; abstract;

    procedure Insert_Datos_Contacto(aChange: TDADeltaChange); virtual;
    procedure Update_Datos_Contacto(aChange: TDADeltaChange); virtual;
    procedure Delete_Datos_Contacto(aChange: TDADeltaChange); virtual;

    procedure Insert_Categoria_Contacto(aChange: TDADeltaChange); virtual;
    procedure Update_Categoria_Contacto(aChange: TDADeltaChange); virtual;
    procedure Delete_Categoria_Contacto(aChange: TDADeltaChange); virtual;

    procedure BeforeProcessDelta(Sender: TDABusinessProcessor;
      const aDelta: IDADelta); override;

    procedure AfterProcessChange(Sender: TDABusinessProcessor;
      aChange: TDADeltaChange; Processed: Boolean;
      var CanRemoveFromDelta: Boolean); override;

    procedure ProcessError(Sender: TDABusinessProcessor;
      aChangeType: TDAChangeType; aChange: TDADeltaChange;
      const aCommand: IDASQLCommand; var CanRemoveFromDelta: Boolean;
      Error: Exception); override;
  end;

implementation

uses
  Dialogs, uDataModuleServer, uDAClasses, Variants,
  schContactosClient_Intf, uBusinessUtils, FactuGES_Intf, uROServer;

{ TBizContactosServer }

procedure TBizContactosServer.AfterProcessChange(Sender: TDABusinessProcessor;
  aChange: TDADeltaChange; Processed: Boolean; var CanRemoveFromDelta: Boolean);
begin
  inherited;
  { Por defecto, mantenemos los deltas por si alguna tabla hija los necesita }
  CanRemoveFromDelta := False;

  case aChange.ChangeType of
    ctInsert: begin
                Insert_Categoria_Contacto(aChange);
                Insert_Datos_Contacto(aChange);
                if FReferenciaAutomatica then
                begin
                  IncrementarReferenciaContacto;
                  FReferenciaAutomatica := False;
                end;
              end;
    ctUpdate: begin
                Update_Categoria_Contacto(aChange);
                Update_Datos_Contacto(aChange);
                if FReferenciaAutomatica then
                begin
                  IncrementarReferenciaContacto;
                  FReferenciaAutomatica := False;
                end;
              end;
    ctDelete: begin
                Delete_Categoria_Contacto(aChange);
                Delete_Datos_Contacto(aChange);
              end;
  end;
end;

procedure TBizContactosServer.BeforeProcessDelta(Sender: TDABusinessProcessor;
  const aDelta: IDADelta);
begin
  inherited;
  FReferenciaAutomatica := False;
  case Sender.CurrentChange.ChangeType of
    ctInsert, ctUpdate: begin
      // Si la referencia no ha sido asignada le asignamos una nosotros
      if REFERENCIAIsNull or (Length(REFERENCIA) = 0) then
      begin
        FReferenciaAutomatica := True;
        REFERENCIA := DarReferenciaContacto;
      end;
    end;
  end;
end;

procedure TBizContactosServer.Delete_Categoria_Contacto(
  aChange: TDADeltaChange);
var
  ASchema : TDASchema;
  ACurrentConn : IDAConnection;
  ACommand : IDASQLCommand;
begin
  ASchema := BusinessProcessor.Schema;
  ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor);

  ACommand := ASchema.NewCommand(ACurrentConn, 'Delete_ContactosCategorias');
  try
    with ACommand do
    begin
      ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID];
      ParamByName('OLD_ID_CATEGORIA').Value := aChange.OldValueByName[fld_ContactosID_CATEGORIA];
      Execute;
    end;
  finally
    ACommand := NIL;
  end;
end;

procedure TBizContactosServer.Delete_Datos_Contacto(aChange: TDADeltaChange);
var
  ASchema : TDASchema;
  ACurrentConn : IDAConnection;
  ACommand : IDASQLCommand;
begin
  ASchema := BusinessProcessor.Schema;
  ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor);

//En el caso de querer tener los contactos separados por empresas en lugar de tenerlos en común
//  ACommand := ASchema.NewCommand(ACurrentConn, 'Delete_ContactoEmpresa');
//En el caso de querer tener los contactos en común para todas las empresas
  ACommand := ASchema.NewCommand(ACurrentConn, 'Delete_ContactoEmpresas');
  try
    with ACommand do
    begin
      ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID];
//      ParamByName('OLD_ID_EMPRESA').Value := aChange.OldValueByName[fld_ContactosID_EMPRESA];
      Execute;
    end;
  finally
    ACommand := NIL;
  end;
end;

procedure TBizContactosServer.Insert_Categoria_Contacto(
  aChange: TDADeltaChange);
var
  ASchema : TDASchema;
  ACurrentConn : IDAConnection;
  ACommand : IDASQLCommand;
begin
  ASchema := BusinessProcessor.Schema;
  ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor);

  ACommand := ASchema.NewCommand(ACurrentConn, 'Insert_ContactosCategorias');
  try
    with ACommand do
    begin
      ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID];
      ParamByName('ID_CATEGORIA').Value := aChange.NewValueByName[fld_ContactosID_CATEGORIA];
      Execute;
    end;
  finally
    ACommand := NIL;
  end;
end;

procedure TBizContactosServer.Insert_Datos_Contacto(aChange: TDADeltaChange);
var
  ASchema : TDASchema;
  ACurrentConn : IDAConnection;
  ACommand : IDASQLCommand;
begin
  ASchema := BusinessProcessor.Schema;
  ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor);

//En el caso de querer tener los contactos separados por empresas en lugar de tenerlos en común
//  ACommand := ASchema.NewCommand(ACurrentConn, 'Insert_ContactoEmpresa');
//En el caso de querer tener los contactos en común para todas las empresas
  ACommand := ASchema.NewCommand(ACurrentConn, 'Insert_ContactoEmpresas');
  try
    with ACommand do
    begin
      ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID];
//      ParamByName('ID_EMPRESA').Value := aChange.NewValueByName[fld_ContactosID_EMPRESA];
      Execute;
    end;
  finally
    ACommand := NIL;
  end;
end;

procedure TBizContactosServer.ProcessError(Sender: TDABusinessProcessor;
  aChangeType: TDAChangeType; aChange: TDADeltaChange;
  const aCommand: IDASQLCommand; var CanRemoveFromDelta: Boolean;
  Error: Exception);
begin
  inherited;
  //IMPORTANTE ESTO HACE QUE EL CLIENTE SE ENTERE DEL ERROR Y LOS BP ASOCIADOS EN EL
  //SCHEMA HAGAN ROLLBACK TAMBIEN
  CanRemoveFromDelta := True;
  raise Exception.Create(Error.Message);
end;

procedure TBizContactosServer.Update_Categoria_Contacto(
  aChange: TDADeltaChange);
var
  ASchema : TDASchema;
  ACurrentConn : IDAConnection;
  ACommand : IDASQLCommand;
begin
  ASchema := BusinessProcessor.Schema;
  ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor);

//En el caso update nos da igual lo que se quiera modificar así que se queda igual
  ACommand := ASchema.NewCommand(ACurrentConn, 'Update_ContactosCategorias');
  try
    with ACommand do
    begin
      ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID];
      ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID];

      ParamByName('ID_CATEGORIA').Value := aChange.NewValueByName[fld_ContactosID_CATEGORIA];
      ParamByName('OLD_ID_CATEGORIA').Value := aChange.OldValueByName[fld_ContactosID_CATEGORIA];
      Execute;
    end;
  finally
    ACommand := NIL;
  end;
end;

procedure TBizContactosServer.Update_Datos_Contacto(aChange: TDADeltaChange);
var
  ASchema : TDASchema;
  ACurrentConn : IDAConnection;
  ACommand : IDASQLCommand;
begin
  ASchema := BusinessProcessor.Schema;
  ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor);

//En el caso update nos da igual lo que se quiera modificar así que se queda igual
  ACommand := ASchema.NewCommand(ACurrentConn, 'Update_ContactoEmpresa');
  try
    with ACommand do
    begin
      ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID];
      ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID];

      ParamByName('ID_EMPRESA').Value := aChange.NewValueByName[fld_ContactosID_EMPRESA];
      ParamByName('OLD_ID_EMPRESA').Value := aChange.OldValueByName[fld_ContactosID_EMPRESA];
      Execute;
    end;
  finally
    ACommand := NIL;
  end;
end;

function TBizContactosServer._DarReferenciaInterna(
  const ATipo: String): String;
var
  AReferenciasService : IsrvReferencias;
  Intf : IInterface;
  AClientID : TGUID;
begin
  CreateGUID(AClientID);

  GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf);
  AReferenciasService := Intf as IsrvReferencias;
  Result := AReferenciasService.DarNuevaReferencia(ATipo, -1)
end;

function TBizContactosServer._IncrementarReferenciaInterna(
  const ATipo: String): Boolean;
var
  AReferenciasService : IsrvReferencias;
  Intf : IInterface;
  AClientID : TGUID;
begin
  CreateGUID(AClientID);

  GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf);
  AReferenciasService := Intf as IsrvReferencias;
  Result := AReferenciasService.IncrementarValorReferencia(ATipo, Self.REFERENCIA, -1)
end;

initialization
  RegisterBusinessProcessorRules(BIZ_SERVER_CONTACTO, TBizContactosServer);

end.
