<% Class AreasController_Class Private m_useLayout Private m_title Private Sub Class_Initialize() m_useLayout = True m_title = "Areas" End Sub Public Property Get useLayout useLayout = m_useLayout End Property Public Property Let useLayout(v) m_useLayout = v End Property Public Property Get Title Title = m_title End Property Public Property Let Title(v) m_title = v End Property '------------------------------------------------------------------------------------------------------------------- ' GET /areas '------------------------------------------------------------------------------------------------------------------- Public Sub index() Dim list, unassigned, csrf Set list = AreaRepository().All() unassigned = AreaRepository().UnassignedCount() csrf = Csrf_Token("areas") %> <% End Sub '------------------------------------------------------------------------------------------------------------------- ' POST /areas/create '------------------------------------------------------------------------------------------------------------------- Public Sub create() Dim name GuardCsrf name = Left(Trim(F("name")), 100) If Len(name) = 0 Then Fail "Enter an area name." If AreaRepository().NameTaken(name, 0) Then Fail """" & name & """ already exists." AreaRepository().Create name Flash().Success = "Added """ & name & """." Response.Redirect "/areas" End Sub '------------------------------------------------------------------------------------------------------------------- ' POST /areas/:id/rename '------------------------------------------------------------------------------------------------------------------- Public Sub rename(id) Dim area, name Set area = Load(id) name = Left(Trim(F("name")), 100) If Len(name) = 0 Then Fail "The name can't be blank." If AreaRepository().NameTaken(name, area("id")) Then Fail """" & name & """ already exists. Use Merge to combine them." End If AreaRepository().Rename area("id"), name Flash().Success = "Renamed to """ & name & """." Response.Redirect "/areas" End Sub '------------------------------------------------------------------------------------------------------------------- ' POST /areas/:id/merge : move every business from this area into another one, then delete this one '------------------------------------------------------------------------------------------------------------------- Public Sub merge(id) Dim area, target, moved Set area = Load(id) If Not Valid_Id(F("target_id")) Then Fail "Choose the area to merge into." If CLng(F("target_id")) = area("id") Then Fail "Choose a different area to merge into." Set target = AreaRepository().Find(CLng(F("target_id"))) If target Is Nothing Then Fail "That area no longer exists." moved = AreaRepository().Merge(area("id"), target("id")) Flash().Success = "Merged """ & area("name") & """ into """ & target("name") & """ (" & moved & " businesses moved)." Response.Redirect "/areas" End Sub '------------------------------------------------------------------------------------------------------------------- ' POST /areas/:id/delete : only when no business is in it '------------------------------------------------------------------------------------------------------------------- Public Sub delete(id) Dim area Set area = Load(id) If area("n") > 0 Then Fail "Can't delete """ & area("name") & """ while " & area("n") & " businesses are in it. Merge it instead." AreaRepository().Delete area("id") Flash().Success = "Deleted """ & area("name") & """." Response.Redirect "/areas" End Sub '------------------------------------------------------------------------------------------------------------------- Private Function Load(id) GuardCsrf If Not Valid_Id(id) Then Response.Redirect "/404" Dim area : Set area = AreaRepository().Find(CLng(id)) If area Is Nothing Then Response.Redirect "/404" Set Load = area End Function Private Sub GuardCsrf() If Not Csrf_Valid("areas", F("csrf")) Then Fail "Invalid form state. Please try again." End Sub Private Sub Fail(msg) Flash().AddError msg Response.Redirect "/areas" End Sub Private Function F(name) F = CStr(Request.Form(name)) End Function End Class Dim AreasController_Class__Singleton Function AreasController() If IsEmpty(AreasController_Class__Singleton) Then Set AreasController_Class__Singleton = New AreasController_Class End If Set AreasController = AreasController_Class__Singleton End Function %>