10
\$\begingroup\$

I had a bit of an issue with my last piece of code, having to do with cleaning up resources. I needed a way to ensure the database connection was always properly closed, even if there still were instances of an IPresenter or IRepository still floating around.

IDisposable class module

Option Explicit

Public Sub Dispose()
End Sub

So I made a minor tweak to my UnitOfWork class, and implemented this IDisposable interface:

UnitOfWork class module

Option Explicit

Private Const CONNECTION_STRING As String = "DRIVER={MySQL ODBC 5.1 Driver};UID=;PWD=;SERVER=;DATABASE=;PORT=;"

Private repositories As New Dictionary
Private adoConnection As New ADODB.Connection

Private disposed As Boolean

Implements IUnitOfWork
Implements IDisposable

Private Sub Class_Initialize()
    adoConnection.ConnectionString = CONNECTION_STRING
    adoConnection.Open
    adoConnection.BeginTrans
End Sub

Private Sub Class_Terminate()
    If Not disposed Then Dispose
End Sub

Public Sub Dispose()
    Set repositories = Nothing
    If Not adoConnection Is Nothing Then
        If adoConnection.State = adStateOpen Then
            adoConnection.RollbackTrans 'rollback any uncommitted changes
            adoConnection.Close
        End If
        Set adoConnection = Nothing
    End If
    disposed = True
End Sub

Private Sub IDisposable_Dispose()
    If Not disposed Then Dispose
End Sub

Public Sub AddRepository(ByVal key As String, ByRef repo As IRepository)
    repo.SetConnection adoConnection
    repositories.Add key, repo
End Sub

Public Property Get Repository(ByVal key As String) As IRepository
    Set Repository = repositories(key)
End Property

Public Sub Commit()
    adoConnection.CommitTrans
    adoConnection.BeginTrans
End Sub

Public Sub Rollback()
    adoConnection.RollbackTrans
    adoConnection.BeginTrans
End Sub

Private Sub IUnitOfWork_AddRepository(ByVal key As String, ByRef repo As IRepository)
    AddRepository key, repo
End Sub

Private Sub IUnitOfWork_Commit()
    Commit
End Sub

Private Sub IUnitOfWork_Dispose()
    IDisposable_Dispose
End Sub

Private Property Get IUnitOfWork_Repository(ByVal key As String) As IRepository
    Set IUnitOfWork_Repository = Repository(key)
End Property

Private Sub IUnitOfWork_Rollback()
    Rollback
End Sub

Now, in an ideal world, I would have made my presenters implement IDisposable too. But isn't very inheritance-friendly (i.e. I can't have IPresenter "extend" IDisposable, and implementing more than 1 interface on a class is possible, but a pain in the neck for the client code), and so I modified the IPresenter interface as follows - basically that's just for documentation purposes, all that really matters is that there's a Public Sub Dispose() method on the IPresenter interface:

IPresenter class module

Option Explicit
Implements IDisposable

...

Public Sub Dispose()
End Sub

Private Sub IDisposable_Dispose()
    Dispose
End Sub

I don't need IPresenter to implement IDisposable - in fact, IDisposable_Dispose will never even be called: this just being for documentation purposes, so I'm wondering, does it actually help, or does it make things more confusing than they need to be? Should I put a comment there?

The IPresenter implementations have been modified as follows (this code is identical in all implementations, if that's a smell):

Private Sub Class_Terminate()
    Dispose
End Sub

Public Sub Dispose()
    If Not View Is Nothing Then Unload View
    If Not this.UnitOfWork Is Nothing Then this.UnitOfWork.Dispose
    If Not this.DetailsPresenter Is Nothing Then this.DetailsPresenter.Dispose
    Set this.UnitOfWork = Nothing
    Set this.View = Nothing
    Set this.DetailsPresenter = Nothing
End Sub

Private Sub IPresenter_Dispose()
    Dispose
End Sub

These disposable heroes make this code possible:

Public Sub MaintainCustomerGroups()

    On Error GoTo ErrHandler
    If IsBusy Then Exit Sub

    Dim presenter As New CustomerGroupsPresenter
    Dim childPresenter As New CustomerGroupDetailsPresenter
    Dim selectorPresenter As New CustomerGroupSelectorPresenter

    Dim uow As New UnitOfWork
    uow.AddRepository "CustomerGroups", New CustomerGroupsRepository
    uow.AddRepository "Customers", New CustomerRepository

    Set presenter.UnitOfWork = uow
    Set childPresenter.UnitOfWork = uow
    Set selectorPresenter.UnitOfWork = uow

    SetupSimplePresenter presenter, _
                         GetResourceString("CustomerGroupsTitle"), _
                         GetResourceString("CustomerGroupsInstructionsText"), _
                         CRUD + ShowDetails

    SetupSimplePresenter childPresenter, _
                         GetResourceString("CustomerGroupCustomersTitle"), _
                         GetResourceString("CustomerGroupCustomersInstructionsText"), _
                         ShowDetails + Refresh

    SetupSelectorPresenter selectorPresenter, _
                           GetResourceString("CustomerGroupSelectorTitle"), _
                           GetResourceString("CustomerGroupSelectorInstructionsText")

    Set presenter.DetailsPresenter = childPresenter
    Set childPresenter.DetailsPresenter = selectorPresenter

    presenter.Show

CleanExit:
    presenter.Dispose
    Exit Sub

ErrHandler:
    MsgBox Err.description, vbCritical, GENERIC_ERR_MSG
    Resume CleanExit
    Resume
End Sub

Notice CleanExit is only calling Dispose on the presenter instance - that's all that needs to happen for the UnitOfWork to close its connection, and I don't need to be doing this:

Set presenter.UnitOfWork = Nothing
Set presenter.DetailsPresenter = Nothing
Set childPresenter.UnitOfWork = Nothing
Set childPresenter.DetailsPresenter = Nothing
Set selectorPresenter.UnitOfWork = Nothing
Set presenter = Nothing
Set childPresenter = Nothing
Set selectorPresenter = Nothing
Set uow = Nothing

...just for Class_Terminate() to be called in the UnitOfWork class, and my database connection properly closed.

So, have I cleaned things up, or made a mess?

\$\endgroup\$
3
\$\begingroup\$

VBA suffers from a lack of proper inheritance and we have to make up for it with composition. In a sensible language, like Ruby (hardy har har) or C#, I would create a PresenterBase class that implements IDisposable and Presenter would then inherit it's Dispose method. Like I said, that's not an option.

So, have you cleaned it up, or made a mess of it? Yes and yes. You can now cleanly dispose of your presenter, but it's not so clean underneath.

Interfaces shouldn't implement other interfaces, as you've noticed it's nonsensical. Remove all of the dispose code from IPresenter. I'm confused by your assertion that Implementing more than one interface is a pain. It's exactly as it should be.

What you should do is create a PresenterBase class that is responsible for defining common code. In this case, the Dispose method. Here is an extremely stripped down example. IDisposable and IPresenter should remain the same (with the exception of removing the disposable code from IPresenter).

PresenterBase

Private Type tPresenter
    MasterId As Long
    Repository As IRepository
    DetailsPresenter As IPresenter
    View As IView
End Type

Private this As tPresenter

Public Sub Dispose()
    IDisposable_Dispose
End Sub

Private Sub IDisposable_Dispose()
    If Not View Is Nothing Then Unload View
    If Not this.UnitOfWork Is Nothing Then this.UnitOfWork.Dispose
    If Not this.DetailsPresenter Is Nothing Then this.DetailsPresenter.Dispose
    Set this.UnitOfWork = Nothing
    Set this.View = Nothing
    Set this.DetailsPresenter = Nothing
End Sub

Presenter

Implements IPresenter
Implements IDisposable

Private base As PresenterBase

Public Property Get UnitOfWork()
    base.UnitOfWork
End Property

'etc

Public Sub Dispose()
    IDisposable_Dispose
End Sub

Private Sub IDisposable_Dispose()
    base.Dispose
End Sub

Private Sub Class_Initialize()
    Set base = New PresenterBase
End Sub
\$\endgroup\$
2
\$\begingroup\$

Type checking/casting is a bit of a pain in VBA, but with a little static helper proper implementation gets much simpler:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Disposable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Sub Dispose(ByRef obj As Object)

    Dim instance As IDisposable

    If obj Is Nothing Then Exit Sub
    If Not TypeOf obj Is IDisposable Then Exit Sub

    Set instance = obj
    instance.Dispose

End Sub

This simple class allows you to get rid of the Public Sub Dispose() methods on IPresenter and IUnitOfWork interfaces, and allows you to do this:

Option Explicit

Private Type tPresenter
    UnitOfWork As IUnitOfWork
    DetailsPresenter As IPresenter
    View As IView
End Type

Private this As tPresenter
Implements IPresenter
Implements IDisposable

...and implement the IDisposable interface cleanly (i.e. without exposing a Dispose() instance member, and without leaking that method into the IPresenter & IUnitOfWork interfaces). In other words, it turns a leaky abstraction into a good one.

The Dispose method in IPresenter implementations can be made Private, and go from this:

Public Sub Dispose()
    If Not View Is Nothing Then Unload View
    If Not this.UnitOfWork Is Nothing Then this.UnitOfWork.Dispose
    If Not this.DetailsPresenter Is Nothing Then this.DetailsPresenter.Dispose
    Set this.UnitOfWork = Nothing
    Set this.View = Nothing
    Set this.DetailsPresenter = Nothing
End Sub

To that:

Private Sub Dispose()

    If Not View Is Nothing Then Unload View
    Disposable.Dispose this.UnitOfWork
    Disposable.Dispose this.DetailsPresenter

    Set this.UnitOfWork = Nothing
    Set this.View = Nothing
    Set this.DetailsPresenter = Nothing

End Sub

And the calling code can now clean up like this:

CleanExit:
    Disposable.Dispose presenter
    Exit Sub

And that leaves you with segregated interfaces that don't pretend to be inheriting one another.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.