文档建议反馈控制台
首页
学习
活动
专区
圈层
工具
MCP广场
文章/答案/技术大牛
发布
首页
学习
活动
专区
圈层
工具
MCP广场
返回腾讯云官网
社区首页 >问答首页 >对计划中的未来条目进行级联更改

问对计划中的未来条目进行级联更改
EN

Code Review用户
提问于 2014-12-08 16:42:04
回答 2查看 86关注 0票数 6

我一直在开发一个调度应用程序，现在我已经完成了中间层。它几天内没有改变，所以我觉得它已经准备好接受审查了。我只有这一套感觉很脏。它肯定接近箭头代码，但没有短路，我不知道如何进一步改进它。

我的Schedule类封装了一个ScheduleEntries集合，并提供了添加条目、删除条目和级联更改的方法(以及侦听底层集合更改的方法)。调用CascadeChanges时，将搜索条目集合以查找脏记录。然后，这些记录在以后的周期中级联到相应的记录。必须满足一些条件，以确保更改被级联到正确的未来条目。目前，我牺牲了大量的性能，以获得更干净、更易读的代码。如何改进这一方法？

代码语言：javascript
运行
复制
Public Sub CascadeChanges()
    Dim innerEntries As SmartScheduleEntries
    Set innerEntries = Me.Entries

    '??? use group id to cascade changes?

    Dim entry As SmartScheduleEntry
    For Each entry In Me.Entries
        If entry.IsDirty Then

            Dim innerEntry As SmartScheduleEntry
            For Each innerEntry In innerEntries

                If innerEntry.Store = entry.Store Then

                    If (innerEntry.Cycle.Year = entry.Cycle.Year _
                        And innerEntry.Cycle.Number > entry.Cycle.Number) _
                    Or innerEntry.Cycle.Year > entry.Cycle.Year Then

                        With innerEntry
                            If .WeekDay = mOldWeekDay And .Week = mOldWeek And .Team = mOldTeam Then
                                .Team = entry.Team
                                .Week = entry.Week
                                .WeekDay = entry.WeekDay
                            End If
                        End With
                    End If

                End If

            Next innerEntry
        End If
    Next entry

    RaiseEvent OnCascadeChanges
End Sub

这是我的两个测试用例。(我一直在使用橡胶鸭对所有这些进行单元测试。)

代码语言：javascript
运行
复制
'@TestMethod
Public Sub CascadeShouldUpdateFuture()
    On Error GoTo TestFail

Arrange:
    Dim mock As SmartSchedule
    Set mock = Mocks.MockFullSchedule

    Dim originalDay As VbDayOfWeek
    originalDay = mock.Entries(1).WeekDay

    Dim shouldBeChanged As New SmartScheduleEntries
    Dim entry As SmartScheduleEntry
    For Each entry In mock.Entries
        If entry.WeekDay = originalDay And entry.Store = 6003 Then
            shouldBeChanged.Add entry, entry.ID
        End If
    Next

Act:

    mock.Entries(1).WeekDay = vbFriday ' make a change to first record
    mock.CascadeChanges

Assert:
    For Each entry In shouldBeChanged
        Assert.AreEqual vbFriday, entry.WeekDay, "Cycle: " & entry.Cycle.ToString
    Next

TestExit:
    Exit Sub
TestFail:
    If Err.Number <> 0 Then
        Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
    Else
        Resume TestExit
    End If
End Sub

'@TestMethod
Public Sub CascadeShouldNotUpdatePast()
    On Error GoTo TestFail

Arrange:
    Dim mock As SmartSchedule
    Set mock = Mocks.MockFullSchedule

    Dim originalDay As VbDayOfWeek
    originalDay = mock.Entries(1).WeekDay

    Dim shouldNotBeChanged As New SmartScheduleEntries
    Dim entry As SmartScheduleEntry
    For Each entry In mock.Entries
        If entry.WeekDay <> originalDay And entry.Store <> 6003 Then
            shouldNotBeChanged.Add entry, entry.ID
        End If
    Next

Act:

    mock.Entries(1).WeekDay = vbFriday ' make a change to first record
    mock.CascadeChanges

Assert:
    For Each entry In shouldNotBeChanged
        Assert.AreNotEqual vbFriday, entry.WeekDay, "Cycle: " & entry.Cycle.ToString & "; Store: " & entry.ToString
    Next

TestExit:
    Exit Sub
TestFail:
    If Err.Number <> 0 Then
        Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
    Else
        Resume TestExit
    End If
End Sub

对于上下文，下面您将找到相关的类。我很高兴收到关于这些的批评，但我对它们很满意。

时间表：

代码语言：javascript
运行
复制
Option Explicit

Private WithEvents mEntries As SmartScheduleEntries

Public Event OnAddEntry(ByRef entry As SmartScheduleEntry)
Public Event OnRemoveEntry(ByRef entry As SmartScheduleEntry)
Public Event OnCascadeChanges()

Private mOldWeek As CycleWeek
Private mOldWeekDay As VbDayOfWeek
Private mOldTeam As String

Public Property Get Entries() As SmartScheduleEntries
    Set Entries = mEntries
End Property

Public Property Set Entries(ByVal value As SmartScheduleEntries)
    Set mEntries = value
End Property

Public Sub AddEntry(ByVal entry As SmartScheduleEntry)
    mEntries.Add entry, entry.ID
    RaiseEvent OnAddEntry(entry)
End Sub

Public Sub RemoveEntry(ByVal entry As SmartScheduleEntry)
    mEntries.Remove entry
    RaiseEvent OnRemoveEntry(entry)
End Sub

Public Sub Validate()
    'todo: implement Validate()
    RaiseNotImplementedError "Validate"
End Sub

Public Sub CascadeChanges()
    Dim innerEntries As SmartScheduleEntries
    Set innerEntries = Me.Entries

    '??? use group id to cascade changes?

    Dim entry As SmartScheduleEntry
    For Each entry In Me.Entries
        If entry.IsDirty Then

            Dim innerEntry As SmartScheduleEntry
            For Each innerEntry In innerEntries

                If innerEntry.Store = entry.Store Then

                    If (innerEntry.Cycle.Year = entry.Cycle.Year _
                        And innerEntry.Cycle.Number > entry.Cycle.Number) _
                    Or innerEntry.Cycle.Year > entry.Cycle.Year Then

                        With innerEntry
                            If .WeekDay = mOldWeekDay And .Week = mOldWeek And .Team = mOldTeam Then
                                .Team = entry.Team
                                .Week = entry.Week
                                .WeekDay = entry.WeekDay
                            End If
                        End With
                    End If

                End If

            Next innerEntry
        End If
    Next entry

    RaiseEvent OnCascadeChanges
End Sub

Public Sub CleanEntries()
    Dim entry As SmartScheduleEntry
    For Each entry In mEntries
        entry.IsDirty = False
    Next
End Sub

Private Sub Class_Initialize()
    Set mEntries = New SmartScheduleEntries
End Sub

Private Sub mEntries_Add(ByRef entry As SmartScheduleEntry)
    ' ReRaises event
    RaiseEvent OnAddEntry(entry)
End Sub

Private Sub mEntries_ItemChanged(ByRef outWeek As CycleWeek, ByRef outWeekDay As VbDayOfWeek, ByRef outTeam As String)
    mOldWeekDay = outWeekDay
    mOldWeek = outWeek
    mOldTeam = outTeam
End Sub

Private Sub mEntries_Remove(ByRef entry As SmartScheduleEntry)
    ' ReRaises Event
    RaiseEvent OnRemoveEntry(entry)
End Sub

Private Sub RaiseNotImplementedError(ByVal procName As String)
    Err.Raise vbObjectError + 1, TypeName(Me) & "." & procName, "Not implemented yet."
End Sub

条目：

代码语言：javascript
运行
复制
Option Explicit

Public Enum ScheduleEntryError
    ReadOnlyPropertyError = vbObjectError + 3333
End Enum

Public Enum CycleWeek
    weekOne = 1
    WeekTwo
End Enum

Private Type TScheduleEntry
    ID As Long
    GroupID As Long
    Cycle As Cycle
    Team As String
    Store As Integer
    WeekDay As VbDayOfWeek
    Week As CycleWeek
    IsDirty As Boolean
End Type

Private this As TScheduleEntry

Public Event OnWeekDayChange(ByRef outDay As VbDayOfWeek)
Public Event OnWeekChange(ByRef outWeek As CycleWeek)
Public Event OnTeamChange(ByRef outTeam As String)

Public Property Get ID() As Long
    ID = this.ID
End Property

Public Property Let ID(ByVal value As Long)
    If this.ID = 0 Then
        this.ID = value
    Else
        RaiseReadOnlyError "ID"
    End If
End Property

Public Property Get GroupID() As Long
    GroupID = this.GroupID
End Property

Public Property Let GroupID(ByVal value As Long)
    If this.GroupID = 0 Then
        this.GroupID = value
    Else
        RaiseReadOnlyError "GroupID"
    End If
End Property

Public Property Get IsDirty() As Boolean
    IsDirty = this.IsDirty
End Property

Public Property Let IsDirty(ByVal value As Boolean)
    this.IsDirty = value
End Property

Public Property Get Team() As String
    Team = this.Team
End Property

Public Property Let Team(ByVal value As String)
    Dim old As String
    old = this.Team

    this.Team = value
    this.IsDirty = True

    RaiseEvent OnTeamChange(old)
End Property

Public Property Get Store() As Integer
    Store = this.Store
End Property

Public Property Let Store(ByVal value As Integer)
    this.Store = value
    this.IsDirty = True
End Property

Public Property Get Cycle() As Cycle
    Set Cycle = this.Cycle
End Property

Public Property Set Cycle(ByVal value As Cycle)
    Set this.Cycle = value
    this.IsDirty = True
End Property

Public Property Get Week() As CycleWeek
    Week = this.Week
End Property

Public Property Let Week(ByVal value As CycleWeek)
    Dim old As CycleWeek
    old = this.Week

    this.Week = value
    this.IsDirty = True

    RaiseEvent OnWeekChange(old)
End Property

Public Property Get WeekDay() As VbDayOfWeek
    WeekDay = this.WeekDay
End Property

Public Property Let WeekDay(ByVal value As VbDayOfWeek)

    Dim old As VbDayOfWeek
    old = this.WeekDay

    this.WeekDay = value
    this.IsDirty = True

    RaiseEvent OnWeekDayChange(old)
End Property

'read-only property
Public Property Get SetDate() As Date
    Dim result As Date

    ' vbMonday == 2, and our week starts on Monday.
    '   If DayOfWeek == vbMonday, it is the startdate, we should add zero days.
    '   In other words, Add (2 - 2) to startdate if it's Monday.

    If this.Week = weekOne Then
        result = DateAdd("d", this.WeekDay - 2, this.Cycle.StartDate)
    Else
        result = DateAdd("d", this.WeekDay - 2 + 7, this.Cycle.StartDate)
    End If

    SetDate = result
End Property

Public Function ToString() As String
    ToString = this.Cycle.ToString & "," & this.Team & "," & this.Store & "," & this.Week & "," & this.WeekDay & "," & this.IsDirty
End Function

Private Sub RaiseReadOnlyError(ByVal procName As String)
    Err.Raise ScheduleEntryError.ReadOnlyPropertyError, TypeName(Me) & "." & procName, "Property Is ReadOnly."
End Sub

条目集合：

代码语言：javascript
运行
复制
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "SmartScheduleEntries"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mCollection As Collection
Private WithEvents mEntryListener As SmartScheduleEntry
Attribute mEntryListener.VB_VarHelpID = -1

Public Event Added(ByRef entry As SmartScheduleEntry)
Public Event Removed(ByRef entry As SmartScheduleEntry)
Public Event ItemChanged(ByRef outWeek As CycleWeek, ByRef outWeekDay As VbDayOfWeek, ByRef outTeam As String)

Public Function Add(ByRef entry As SmartScheduleEntry, ByVal Key As Long)
    mCollection.Add entry, CStr(Key)
    RaiseEvent Added(entry)
End Function

Public Function Remove(ByVal entry As SmartScheduleEntry)

    mCollection.Remove IndexOf(entry)

    RaiseEvent Removed(entry)
End Function

Public Function Item(ByVal index As Variant) As SmartScheduleEntry
Attribute Item.VB_UserMemId = 0

    Set mEntryListener = mCollection(index)
    Set Item = mEntryListener

End Function

Public Function Count() As Long
    Count = mCollection.Count
End Function

' returns index of item if found, returns 0 if not found
Public Function IndexOf(ByVal entry As SmartScheduleEntry) As Long
    Dim i As Long
    For i = 1 To mCollection.Count
        If mCollection(i).ID = entry.ID Then
            IndexOf = i
            Exit Function
        End If
    Next
End Function

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = mCollection.[_NewEnum]
End Function

Private Sub Class_Initialize()
    Set mCollection = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCollection = Nothing
End Sub

Private Sub mEntryListener_OnTeamChange(ByRef outTeam As String)
    RaiseEvent ItemChanged(mEntryListener.Week, mEntryListener.WeekDay, outTeam)
End Sub

Private Sub mEntryListener_OnWeekChange(ByRef outWeek As CycleWeek)
    RaiseEvent ItemChanged(outWeek, mEntryListener.WeekDay, mEntryListener.Team)
End Sub

Private Sub mEntryListener_OnWeekDayChange(ByRef outDay As VbDayOfWeek)
    RaiseEvent ItemChanged(mEntryListener.Week, outDay, mEntryListener.Team)
End Sub

循环：

代码语言：javascript
运行
复制
Option Explicit

Private Type TCycle
    StartDate As Date
    EndDate As Date
    Year As Integer
    Number As Integer
End Type

Private this As TCycle

Public Property Get Year() As Integer
    Year = this.Year
End Property

Public Property Let Year(ByVal value As Integer)
    this.Year = value
End Property

Public Property Get Number() As Integer
    Number = this.Number
End Property

Public Property Let Number(ByVal value As Integer)
    this.Number = value
End Property

Public Property Get StartDate() As Date
    StartDate = DateValue(this.StartDate)
End Property

Public Property Let StartDate(ByVal value As Date)
    this.StartDate = value
End Property

Public Property Get EndDate() As Date
    EndDate = DateValue(this.EndDate)
End Property

Public Property Let EndDate(ByVal value As Date)
    this.EndDate = value
End Property

Public Function ToString() As String
    ToString = this.Year & "-P" & Format(this.Number, "00")
End Function

Public Sub SetFromString(ByVal value As String)
    Dim arr As Variant

    arr = Split(value, "-P", 2)
    Me.Year = arr(0)
    Me.Number = arr(1)
End Sub
vba
EN

回答 2

Code Review用户

回答已采纳

发布于 2014-12-08 18:03:35

Arrow AntiPattern

是的，您的箭头代码很脏，可以分解成其他方法。它们现在可能只在一种方法中使用，但是随着代码的扩展，您会发现已经定义了这些方法是很方便的。我发现，将每一种方法保持在一两种控制结构中是有帮助的。请使用比我所用的更好的名称，因为我不完全理解你的产品。

代码语言：javascript
运行
复制
Public Sub CascadeChanges()

    Dim entries As SmartScheduleEntries
    Set entries = Me.Entries

    Dim entry As SmartScheduleEntry
    For Each entry in entries 
        If entry.IsDirty Then CascadeEntry entry, entries
    Next entry

    RaiseEvent OnCascadeChanges

End Sub
Private Sub CascadeEntry(ByVal inputEntry As SmartScheduleEntry, _
        ByVal entries As SmartScheduleEntries)

    Dim entry As SmartScheduleEntry
    For Each entry In entries
        If OughtCascade(inputEntry, entry) And IsOutDated(entry) Then 
            DoCascade inputEntry, entry
        End If
    Next entry 

End Sub
Private Function IsOutDated(ByVal entry As SmartScheduleEntry) As Boolean
    IsOutDated = (entry.WeekDay = mOldWeekDay And _
                  entry.Week = mOldWeek And _
                  entry.Team = mOldTeam)
End Function

您可能希望抽象出OughtCascade的各种比较，但我确实知道哪些比较与抽象有关。所有的比较都是简单的性质，因此缺乏短路评价具有边际成本。回顾一下Scheduler类，并不是所有这些方法都属于该类。下面两个可以移植到您的SmartScheduleEntry类。

代码语言：javascript
运行
复制
Private Function OughtCascade(ByVal entryFrom SmartScheduleEntry, _
        ByVal entryTo SmartScheduleEntry) As Boolean
    OughtCascade = (entryFrom.Store = entryTo.Store) And _
                   ((entryFrom.Cycle.Year = entryTo.Cycle.Year) And _
                   (entryFrom.Cycle.Number < entryTo.Cycle.Number) Or _
                   (entryFrom.Cycle.Year < entryTo.Cycle.Year))
End Function

Public Sub DoCascade(ByRef entryFrom As SmartScheduleEntry, _
        ByRef entryTo As SmartScheduleEntry

    With entryTo

            .Team = entryFrom.Team
            .Week = entryFrom.Week
            .WeekDay = entryFrom.WeekDay

    End With

End Sub

IsDirty是肮脏的

再看一看您的代码，我就开始怀疑IsDirty成员了。我相信物业应评估该项目是否肮脏，而不是从会员那里读取。它似乎是导致锅炉板代码在让属性的其他成员。

公共属性设WeekDay(ByVal value As VbDayOfWeek) Dim old As VbDayOfWeek old = this.WeekDay this.WeekDay = value this.IsDirty = True RaiseEvent OnWeekDayChange(old) End Property

问题是Get IsDirty依赖于Let WeekDay和其他属性的代码。Get IsDirty应该独立于它没有具体引用的任何方法。隔离IsDirty可能需要完全重新设计您的结构。鉴于IsDirty似乎是HasMutated的同义词，请考虑使您的SmartScheduleEntry类不可变。

票数 3
EN

Code Review用户

发布于 2014-12-09 21:42:57

我以为你知道比用魔术数字更好

对于mock.Entries中的每个条目，If entry.WeekDay = originalDay和entry.Store = 6003然后shouldBeChanged.Add条目，entry.ID结束如果Next

6003商店有什么特别之处？

这是什么错误？

公共Enum ScheduleEntryError ReadOnlyPropertyError = vbObjectError + 3333末端Enum

魔术数字错误？

我发现这对解释这里的逻辑是有用的，否则的话就没有意义了。

“只读属性公共属性将SetDate()作为Date结果作为Date”vbMonday == 2，我们的一周从周一开始。‘如果DayOfWeek == vbMonday是开始日期，我们应该增加零天。‘换句话说，如果是星期一，在开始日期加上(2-2)。如果this.Week = weekOne则结果= DateAdd("d"，this.WeekDay - 2，this.Cycle.StartDate)，则this.WeekDay = DateAdd("d"，this.WeekDay-2+ 7，this.Cycle.StartDate)结束，如果SetDate =结果结束属性

不管怎么说，对于VB来说，代码看起来很漂亮。

票数 3
EN
页面原文内容由Code Review提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：

https://codereview.stackexchange.com/questions/72033

复制
相关文章

相似问题

领券

腾讯云开发者

扫码关注腾讯云开发者

扫码关注腾讯云开发者

领取腾讯云代金券

热门产品

热门推荐

更多推荐

Copyright © 2013 - 2025 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有 

深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 深公网安备号 44030502008569

腾讯云计算（北京）有限责任公司 京ICP证150476号 |  京ICP备11018762号 | 京公网安备号11010802020287

问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档