Role based programming in Bold

An example of implementing the Actor/Role pattern in Bold.

Role based programming in Bold

Bold allows developers to develop OOP applications which persist to a database. This gives us the ability to add inheritance to our applications, but this ability can be over used.

As an example, in an application I developed in Bold once I had the following model

The above structure allows the application to record purchase orders against a Customer, admin work can be assigned to an AdminEmployee, and flight information can be recorded against a Pilot.

Role based

The problem with the above scenario is when roles start to get mixed. For example, an Employee may become a Customer, or a Pilot may do some part-time administration work.

The solution to this problem is to use the Actor/Role pattern. Each Actor (abstract class) may receive multiple Roles (also an abstract class). It is these Roles which have business related information associated with them. For example a PilotRole would have the flight information associated with it, and the CustomerRole would have purchase orders associated with it.

The newer model would look something like this.

1. An Actor may have no roles, or many roles.
2. A specific instance of an Actor may forbid the removal of a role.
3. A role may deny application to a specific Actor.
4. A role may specify that it is required and cannot be removed (ie, LoginRole cannot be removed because the user also has a SystemAdministratorRole)
5. A specific instance of an Actor may reject a role.

Listing 1: Actor

//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;

Listing 2: Role

//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;

The code so far has all been abstract. All that is left is to descend some concrete classes from Actor and Role.

Conclusion

Instead of having an Employee class or a Customer class, we can now easily assign an EmployeeRole or CustomerRole to any type of Person object (which is an Actor).

Additionally we can mix roles, a Pilot can perform administration, and anything could be a customer (a Person, Department, a Company, or even a Country).

I hope this article has been informative.