Programação role-based em negrito

Um exemplo de aplicação do Ator/Role padrão em Negrito.

Programação role-based em Negrito

Negrito permite aos desenvolvedores criar aplicações OOP que persistem para uma base de dados. Isto nos dá a capacidade de adicionar herança aos nossos pedidos, mas esta capacidade pode ser utilizada em excesso.

Como exemplo, em uma aplicação que eu desenvolvi em Negrito uma vez eu tive o seguinte modelo

A estrutura acima permite que a aplicação registre ordens de compra contra um cliente, trabalho administrativo pode ser atribuído a um AdminEmployee, e informações de vôo podem ser registradas contra um piloto.

Role based

O problema com o cenário acima é quando os roles (papéis) começam a se misturar. Por exemplo, um Empregado pode se tornar um cliente, ou um piloto pode fazer algum trabalho administrativo em tempo parcial.

A solução para esse problema é usar o Ator/Role padrão. Cada Ator (classe abstrata) pode receber vários papéis (também uma classe abstrata). É nesses papéis que têm negócios relacionados com as informações que lhes estão associados. Por exemplo, um PilotRole teria a informação de vôo associada a ele, e o CustomerRole teria as ordens de compra associadas a ele.

O mais novo modelo seria parecido com este.

    Um ator pode não ter papéis, ou muitos papéis.

    Um exemplo específico de um ator pode proibir a remoção de um papel.

    Um papel pode negar aplicação a um determinado ator.

    Um papel pode especificar que ele é necessária e não pode ser removido (ou seja, LoginRole não pode ser removido porque o usuário também tem um SystemAdministratorRole)

    Um exemplo específico de um ator pode rejeitar um papel.

Listagem 1: Ator

//Accept or reject a role
function TActor.CanAcceptRole(ARoleClass: TRoleClass): Boolean;
begin
  if not ARoleClass.AllowDuplicates and HasRole(ARoleClass, nil) then
    Result := False
  else
    if not ARoleClass.AllowActiveDuplicates and
       HasActiveRole(ARoleClass, nil) then
      Result := False
    else
      Result := ARoleClass.CanApplyTo(Self);
end;
//Allow or disallow removal of a role
function TActor.CanRemoveRole(ARole: TRole): Boolean;
begin
  Result := not ARole.IsRequired;
end;



//Returns a role, but only if it is active
function TActor.FindActiveRole(AClass: TClass; ExcludeInstance: TRole): TRole;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Roles.Count - 1 do
    if Roles[I].Active and (Roles[I].ClassType = AClass) and
       (Roles[I] <> ExcludeInstance) then
    begin
      Result := Roles[I];
      Break;
    end;
end;



//Returns a role, whether active or not
function TActor.FindRole(AClass: TClass; ExcludeInstance: TRole): TRole;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Roles.Count - 1 do
    if (Roles[I].ClassType = AClass) and
       (Roles[I] <> ExcludeInstance) then
    begin
      Result := Roles[I];
      Break;
    end;
end;



//Returns True if the Actor owns a specific role and it is active
function TActor.HasActiveRole(AClass: TClass; ExcludeInstance: TRole): Boolean;
begin
  Result := Assigned(FindActiveRole(AClass, ExcludeInstance));
end;



//Returns True if the Actors owns a specific role (active or inactive)
function TActor.HasRole(AClass: TClass; ExcludeInstance: TRole): Boolean;
begin
  Result := Assigned(FindRole(AClass, ExcludeInstance));
end;



function TActor.ReceiveQueryFromOwned(Originator: TObject; OriginalEvent: TBoldEvent;
  const Args: array of const; Subscriber: TBoldSubscriber): Boolean;
var
  ObjectLocator: TBoldObjectLocator;
  Role: TRole;
begin
  Result := inherited ReceiveQueryFromOwned(Originator, OriginalEvent, Args, Subscriber);
  if not Result or BoldObjectIsDeleted then Exit;  //Check for insertion of roles
  if (Originator = M_Roles) then
  begin
    if OriginalEvent = bqMayInsert then
    begin
      //Get the role being inserted
      Assert(Args[1].VType = vtObject);
      ObjectLocator := (Args[1].VObject as TBoldObjectLocator);
      Role := (ObjectLocator.BoldObject as TRole);      //Check for duplicate roles which are not allowed
      if (not Role.AllowDuplicates) and
         (HasRole(Role.ClassType, nil)) then
      begin
        Result := False;
        SetBoldLastFailureReason(
          TBoldFailureReason.Create('This role may only be applied once', Self)
        );
      end else
      //Check for duplicate active roles which are not allowed
      if (not Role.AllowActiveDuplicates) and
         (HasActiveRole(Role.ClassType, nil)) then
      begin
        Result := False;
        SetBoldLastFailureReason(
          TBoldFailureReason.Create('Cannot apply this role because ' +
            'there is already an active role of this kind', Self)
        );
      end else
        Result := CanAcceptRole(TRoleClass(Role.ClassType));
if not Result then
        SetBoldLastFailureReason(
          TBoldFailureReason.Create('Role cannot be applied to this object', Self)
        );
    end else //bqMayInsert
    //Check for the removal of roles
    if OriginalEvent = bqMayRemove then
    begin
      //Get the role object being removed
      Assert(Args[0].VType = vtInteger);
      Role := Roles[Args[0].VInteger];
      Result := (not Role.Active) or (not Role.IsRequired);
      if not Result then
        SetBoldLastFailureReason(
          TBoldFailureReason.Create('Role cannot be removed, ' +
            'it is required by another active role', Self)
        );
    end; //bqMayRemove
  end;
end;

Listagen 2: Role (Papel)


//Allow or disallow application to a specific Actor
class function TRole.CanApplyTo(AObject: TActor): Boolean;
begin
  Result := False;
end;



//Virtual method to override in descendants which describes the role
class function TRole.GetRoleName: string;
begin
  Result := '';
end;



//Optional, specifies if active duplicates are allowed or not
class function TRole.AllowActiveDuplicates: Boolean;
begin
  Result := False;
end;



//Optional, specifies if duplicates are allowed or not (active or inactive)
class function TRole.AllowDuplicates: Boolean;
begin
  Result := False;
end;



//Returns True if any role depends on this role to be present
function TRole.IsRequired: Boolean;
var
  I: Integer;
begin
  if Actor <> nil then
  begin
    Result := True;
    for I := 0 to Actor.Roles.Count - 1 do
      if Actor.Roles[I] <> self then
        if Actor.Roles[I].RequiresRole(self) then
          Exit;
  end;
  Result := False;
end;



//Override this to specify if another role is depended upon
function TRole.RequiresRole(ARole: TRole): Boolean;
begin
  Result := False;
end;



//Populates the derived RoleName attribute from the class method
procedure TRole._RoleName_DeriveAndSubscribe(DerivedObject: TObject; Subscriber: TBoldSubscriber);
begin
  inherited;
  M_RoleName.AsString := GetRoleName;
end;



//Prevents the deletion of a required role
function TRole.MayDelete: Boolean;
begin
  Result := not IsRequired;
end;



function TRole.ReceiveQueryFromOwned(Originator: TObject; OriginalEvent: TBoldEvent;
  const Args: array of const; Subscriber: TBoldSubscriber): Boolean;
begin
  Result := inherited ReceiveQueryFromOwned(Originator,
     OriginalEvent, Args, Subscriber);
  if not Result then Exit;
  if (Originator = M_Active) then //Active attribute
  begin
    if OriginalEvent = bqMayModify then
    begin
      if Actor = nil then
        Result := True
      else
      if Active then
      begin
       //Disallow deactivation if another role requires
        //this role to be active
        Result := not IsRequired;
        if not Result then
         SetBoldLastFailureReason(
            TBoldFailureReason.Create('Cannot deactivate this role, ' +
              'other roles require it', Self)
          );
      end else
      begin
        //Disallow reactivation if another active role exists
        //and duplicates are not allowed
        Result := AllowActiveDuplicates or (not Actor.HasActiveRole(Self.ClassType, Self));
        if not Result then
          SetBoldLastFailureReason(
            TBoldFailureReason.Create('Cannot activate this role ' +
              'because there is already a similar active role', Self)
          );
      end;
    end; //bqMayModify

  end; //Active attributeend;
end;

O código até agora tem sido todo abstrato. Tudo o que é que resta é a descer algumas classes concretas do Ator e Papel.

Conclusão

Em vez de ter uma classe de empregados ou uma classe de cliente, podemos agora facilmente atribuir um EmployeeRole ou CustomerRole a qualquer tipo de objeto Pessoa (que é um ator).

Além disso, podemos misturar papéis, um piloto pode executar a administração, e qualquer coisa poderia ser um cliente (uma pessoa, departamento, uma companhia, ou até mesmo um País).

Espero que este artigo tenha sido esclarecedor.