<% Class BusinessesController_Class Private m_useLayout Private m_title Private Sub Class_Initialize() m_useLayout = True m_title = "Businesses" 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 /businesses : searchable, filterable, sortable, paged list '------------------------------------------------------------------------------------------------------------------- Public Sub index() Const PER_PAGE = 50 Dim f, k, page, pageCount, result, rows, total, industries, areas, sort, dir, firstRow, lastRow Set f = CreateObject("Scripting.Dictionary") For Each k In Array("q", "industry", "area", "status", "show", "contacted", "phone", "sort", "dir") f(k) = Trim(CStr(Request.QueryString(k))) Next f("q") = Left(f("q"), 100) page = 1 Dim pageText : pageText = CStr(Request.QueryString("page")) If Len(pageText) > 0 And Len(pageText) <= 6 Then If IsNumeric(pageText) Then page = CLng(pageText) End If If page < 1 Then page = 1 Set result = BusinessRepository().Search(f, page, PER_PAGE) total = result("total") Set rows = result("rows") Set industries = BusinessRepository().Industries() Set areas = AreaRepository().All() pageCount = Int((total + PER_PAGE - 1) / PER_PAGE) If pageCount < 1 Then pageCount = 1 If page > pageCount Then page = pageCount Set result = BusinessRepository().Search(f, page, PER_PAGE) Set rows = result("rows") End If sort = f("sort") : dir = LCase(f("dir")) If dir <> "desc" Then dir = "asc" If total = 0 Then firstRow = 0 Else firstRow = (page - 1) * PER_PAGE + 1 lastRow = firstRow + rows.Count - 1 If total = 0 Then lastRow = 0 %> <% End Sub '------------------------------------------------------------------------------------------------------------------- ' GET /businesses/:id : detail, history and the "log a touch" form '------------------------------------------------------------------------------------------------------------------- Public Sub show(id) Dim b If Not Valid_Id(id) Then Response.Redirect "/404" Set b = BusinessRepository().Find(CLng(id)) If b Is Nothing Then Response.Redirect "/404" RenderShow id, b, Nothing, Nothing End Sub ' Renders the detail page. dup (a matching other business) and fv (unsaved form values) are Nothing normally. Private Sub RenderShow(id, b, dup, fv) Dim interactions, industries, allAreas, bizAreas, areaSel, ai, csrf, today Set interactions = BusinessRepository().Interactions(CLng(id)) Set industries = BusinessRepository().Industries() Set allAreas = AreaRepository().All() Set bizAreas = AreaRepository().ForBusiness(CLng(id)) ' Ticked area ids (CStr keys): the saved ones, or the unsaved selection when re-showing the form. If fv Is Nothing Then Set areaSel = CreateObject("Scripting.Dictionary") For ai = 0 To bizAreas.Count - 1 areaSel(CStr(bizAreas(ai)("id"))) = True Next Else Set areaSel = fv("_area_ids") End If csrf = Csrf_Token("business") today = Date_Iso(Date) m_title = b("name") %> <% End Sub '------------------------------------------------------------------------------------------------------------------- ' POST /businesses/:id/update : edit details '------------------------------------------------------------------------------------------------------------------- Public Sub update(id) Dim d, email, phone, indName, indSel, areaIds, areaNew, ai, areaId, areaName GuardPost id Set d = CreateObject("Scripting.Dictionary") d("name") = Left(Trim(F("name")), 255) If Len(d("name")) = 0 Then Flash().AddError "Business name is required." Response.Redirect "/businesses/" & id End If email = LCase(Left(Trim(F("email")), 255)) If Len(email) > 0 And InStr(email, "@") = 0 Then Flash().AddError "That email address doesn't look right, so nothing was saved." Response.Redirect "/businesses/" & id End If phone = Left(Trim(F("phone")), 40) d("contact_name") = Left(Trim(F("contact_name")), 150) d("phone") = phone d("phone_digits") = ImportFile_PhoneDigits(phone) d("email") = email d("website") = Left(Trim(F("website")), 255) d("address1") = Left(Trim(F("address1")), 255) d("city") = Left(Trim(F("city")), 100) d("state") = Left(Trim(F("state")), 50) d("zip") = Left(Trim(F("zip")), 20) d("notes") = Left(F("notes"), 10000) If F("is_customer") = "1" Then d("is_customer") = 1 Else d("is_customer") = 0 d("first_order_date") = Date_Parse(F("first_order_date")) indName = Trim(F("industry_new")) indSel = F("industry_id") If Valid_Id(indSel) Then d("industry_id") = CLng(indSel) Else d("industry_id") = Null ' Areas: the ticked boxes, plus any comma-separated new names (created once the save is going ahead). Set areaIds = CreateObject("Scripting.Dictionary") For ai = 1 To Request.Form("area_ids").Count If Valid_Id(Request.Form("area_ids")(ai)) Then areaIds(CStr(CLng(Request.Form("area_ids")(ai)))) = True Next areaNew = Left(Trim(F("area_new")), 500) ' Warn when a changed phone/email is already used by another business (unless "Save anyway" was pressed). If F("allow_duplicate") <> "1" Then Dim existing, chkPhone, chkEmail, dupMatch, fv Set existing = BusinessRepository().Find(CLng(id)) chkPhone = "" : chkEmail = "" If d("phone_digits") <> existing("phone_digits") & "" Then chkPhone = d("phone_digits") If d("email") <> existing("email") & "" Then chkEmail = d("email") Set dupMatch = BusinessRepository().FindDuplicate(CLng(id), chkPhone, chkEmail) If Not dupMatch Is Nothing Then Set fv = CreateObject("Scripting.Dictionary") Dim k For Each k In d.Keys fv(k) = d(k) Next fv("_industry_new") = indName fv("_area_new") = areaNew Set fv("_area_ids") = areaIds RenderShow id, existing, dupMatch, fv Exit Sub End If End If ' A typed-in industry wins over the dropdown; it is only created once the save is going ahead. If Len(indName) > 0 Then d("industry_id") = BusinessRepository().FindOrCreateIndustry(indName) For Each areaName In Split(areaNew, ",") areaId = AreaRepository().FindOrCreate(areaName) If Not IsNull(areaId) Then areaIds(CStr(areaId)) = True Next BusinessRepository().Update CLng(id), d AreaRepository().SetForBusiness CLng(id), areaIds Flash().Success = "Saved." Response.Redirect "/businesses/" & id End Sub '------------------------------------------------------------------------------------------------------------------- ' POST /businesses/:id/log : record a call / email / visit / mailing '------------------------------------------------------------------------------------------------------------------- Public Sub log(id) Dim method, outcome, notes, contactedAt, followUp, removing, reason GuardPost id method = F("method") outcome = F("outcome") If Not Businesses_IsKey(Businesses_Methods(), method) Then Flash().AddError "Choose how you contacted them." Response.Redirect "/businesses/" & id End If If Len(outcome) > 0 And Not Businesses_IsKey(Businesses_Outcomes(), outcome) Then outcome = "" contactedAt = Date_Parse(F("contacted_at")) If IsNull(contactedAt) Then contactedAt = Date If contactedAt > Date + 1 Then Flash().AddError "The contact date can't be in the future." Response.Redirect "/businesses/" & id End If followUp = Date_Parse(F("follow_up_date")) notes = Left(F("notes"), 10000) removing = (outcome = "remove") reason = Businesses_Label(Businesses_Outcomes(), outcome) If removing And Len(Trim(notes)) > 0 Then reason = Left(Trim(notes), 255) BusinessRepository().LogInteraction CLng(id), method, outcome, notes, contactedAt, followUp, removing, reason If removing Then Flash().Success = "Logged and removed from the list." ElseIf Not IsNull(followUp) Then Flash().Success = "Logged. Follow-up set for " & Date_Fmt(followUp) & "." Else Flash().Success = "Logged." End If Response.Redirect "/businesses/" & id End Sub '------------------------------------------------------------------------------------------------------------------- ' POST /businesses/:id/remove and /restore '------------------------------------------------------------------------------------------------------------------- Public Sub remove(id) GuardPost id BusinessRepository().Remove CLng(id), Left(Trim(F("reason")), 255) Flash().Success = "Removed from the list." Response.Redirect "/businesses/" & id End Sub Public Sub restore(id) GuardPost id BusinessRepository().Restore CLng(id) Flash().Success = "Restored." Response.Redirect "/businesses/" & id End Sub '------------------------------------------------------------------------------------------------------------------- ' Shared checks and helpers '------------------------------------------------------------------------------------------------------------------- Private Sub GuardPost(id) If Not Valid_Id(id) Then Response.Redirect "/404" If BusinessRepository().Find(CLng(id)) Is Nothing Then Response.Redirect "/404" If Not Csrf_Valid("business", F("csrf")) Then Flash().AddError "Invalid form state. Please try again." Response.Redirect "/businesses/" & id End If End Sub Private Function F(name) F = CStr(Request.Form(name)) End Function End Class Dim BusinessesController_Class__Singleton Function BusinessesController() If IsEmpty(BusinessesController_Class__Singleton) Then Set BusinessesController_Class__Singleton = New BusinessesController_Class End If Set BusinessesController = BusinessesController_Class__Singleton End Function %>