<% '======================================================================================================================= ' AREA REPOSITORY ' Areas (cities, regions...) and which businesses cover them. A business can be linked to any number of areas ' through business_areas (business_id, area_id). '======================================================================================================================= Class AreaRepository_Class ' All areas with the number of businesses in each: list of Dictionary(id, name, n) Public Function All() Dim list, rs, d Set list = CreateObject("Scripting.Dictionary") Set rs = Db_Query("SELECT a.id, a.name, COUNT(ba.business_id) AS n FROM areas a LEFT JOIN business_areas ba ON ba.area_id = a.id GROUP BY a.id, a.name ORDER BY a.name", Array()) Do While Not rs.EOF Set d = CreateObject("Scripting.Dictionary") d("id") = CLng(rs(0)) : d("name") = rs(1) & "" : d("n") = CLng(rs(2)) list.Add list.Count, d rs.MoveNext Loop rs.Close Set All = list End Function ' Businesses not linked to any area. Public Function UnassignedCount() Dim rs Set rs = Db_Query("SELECT COUNT(*) FROM businesses b WHERE NOT EXISTS (SELECT ba.area_id FROM business_areas ba WHERE ba.business_id = b.id)", Array()) UnassignedCount = CLng(rs(0)) rs.Close End Function Public Function Find(id) Dim rs Set rs = Db_Query("SELECT a.id, a.name, (SELECT COUNT(*) FROM business_areas ba WHERE ba.area_id = a.id) AS n FROM areas a WHERE a.id = ?", Array(Db_PI(id))) If rs.EOF Then Set Find = Nothing Else Dim d : Set d = CreateObject("Scripting.Dictionary") d("id") = CLng(rs(0)) : d("name") = rs(1) & "" : d("n") = CLng(rs(2)) Set Find = d End If rs.Close End Function ' True when another area (not excludeId) already has this name (case-insensitive). Public Function NameTaken(name, excludeId) Dim rs Set rs = Db_Query("SELECT COUNT(*) FROM areas WHERE name = ? AND id <> ?", Array(Db_PS(name), Db_PI(excludeId))) NameTaken = (CLng(rs(0)) > 0) rs.Close End Function Public Sub Create(name) Db_Exec "INSERT INTO areas (name) VALUES (?)", Array(Db_PS(name)) End Sub ' Returns the area id for a name, creating the area when it does not exist. Null for a blank name. Public Function FindOrCreate(ByVal name) Dim rs name = Left(Trim(name), 100) If Len(name) = 0 Then FindOrCreate = Null Exit Function End If Set rs = Db_Query("SELECT id FROM areas WHERE name = ?", Array(Db_PS(name))) If Not rs.EOF Then FindOrCreate = CLng(rs(0)) rs.Close Exit Function End If rs.Close Create name Set rs = Db_Query("SELECT @@IDENTITY", Array()) FindOrCreate = CLng(rs(0)) rs.Close End Function Public Sub Rename(id, name) Db_Exec "UPDATE areas SET name = ? WHERE id = ?", Array(Db_PS(name), Db_PI(id)) End Sub ' Moves every business from sourceId to targetId (a business already in both keeps one link), then deletes ' sourceId. Returns the number of businesses that were in sourceId. Public Function Merge(sourceId, targetId) Dim conn, moved, rs, msg Set conn = DAL().Connection Set rs = Db_Query("SELECT COUNT(*) FROM business_areas WHERE area_id = ?", Array(Db_PI(sourceId))) moved = CLng(rs(0)) rs.Close conn.BeginTrans On Error Resume Next ' Ids inlined as CLng: Access binds ? markers inside a subquery ahead of the outer ones. Db_Exec "DELETE FROM business_areas WHERE area_id = " & CLng(sourceId) & _ " AND business_id IN (SELECT x.business_id FROM business_areas x WHERE x.area_id = " & CLng(targetId) & ")", Array() If Err.Number = 0 Then Db_Exec "UPDATE business_areas SET area_id = ? WHERE area_id = ?", Array(Db_PI(targetId), Db_PI(sourceId)) If Err.Number = 0 Then Db_Exec "DELETE FROM areas WHERE id = ?", Array(Db_PI(sourceId)) If Err.Number <> 0 Then msg = Err.Description Err.Clear conn.RollbackTrans On Error GoTo 0 Err.Raise 5, "AreaRepository.Merge", msg End If conn.CommitTrans On Error GoTo 0 Merge = moved End Function Public Sub Delete(id) Db_Exec "DELETE FROM areas WHERE id = ?", Array(Db_PI(id)) End Sub '--------------------------------------------------------------------------------------------------------------------- ' Links to businesses '--------------------------------------------------------------------------------------------------------------------- ' Areas of one business: list of Dictionary(id, name), by name. Public Function ForBusiness(businessId) Dim list, rs, d Set list = CreateObject("Scripting.Dictionary") Set rs = Db_Query("SELECT a.id, a.name FROM business_areas ba INNER JOIN areas a ON a.id = ba.area_id WHERE ba.business_id = ? ORDER BY a.name", Array(Db_PI(businessId))) Do While Not rs.EOF Set d = CreateObject("Scripting.Dictionary") d("id") = CLng(rs(0)) : d("name") = rs(1) & "" list.Add list.Count, d rs.MoveNext Loop rs.Close Set ForBusiness = list End Function ' Area names for many businesses at once: Dictionary CStr(business id) -> "Name, Name". ids is a comma-separated ' list of numeric ids (callers build it from CLng values) or "" for every business. Public Function NamesByBusiness(ids) Dim names, rs, sql, k Set names = CreateObject("Scripting.Dictionary") sql = "SELECT ba.business_id, a.name FROM business_areas ba INNER JOIN areas a ON a.id = ba.area_id" If Len(ids) > 0 Then sql = sql & " WHERE ba.business_id IN (" & ids & ")" Set rs = Db_Query(sql & " ORDER BY ba.business_id, a.name", Array()) Do While Not rs.EOF k = CStr(rs(0)) If names.Exists(k) Then names(k) = names(k) & ", " & rs(1) Else names(k) = rs(1) & "" rs.MoveNext Loop rs.Close Set NamesByBusiness = names End Function ' Replaces the areas of a business with areaIds (Dictionary whose keys are area ids). Unknown ids are ignored. Public Sub SetForBusiness(businessId, areaIds) Dim conn, known, rs, k, msg Set known = CreateObject("Scripting.Dictionary") Set rs = Db_Query("SELECT id FROM areas", Array()) Do While Not rs.EOF known(CStr(rs(0))) = True rs.MoveNext Loop rs.Close Set conn = DAL().Connection conn.BeginTrans On Error Resume Next Db_Exec "DELETE FROM business_areas WHERE business_id = ?", Array(Db_PI(businessId)) For Each k In areaIds.Keys If Err.Number <> 0 Then Exit For If known.Exists(CStr(k)) Then Db_Exec "INSERT INTO business_areas (business_id, area_id) VALUES (?, ?)", Array(Db_PI(businessId), Db_PI(k)) End If Next If Err.Number <> 0 Then msg = Err.Description Err.Clear conn.RollbackTrans On Error GoTo 0 Err.Raise 5, "AreaRepository.SetForBusiness", msg End If conn.CommitTrans On Error GoTo 0 End Sub End Class Dim AreaRepository_Class__Singleton Function AreaRepository() If IsEmpty(AreaRepository_Class__Singleton) Then Set AreaRepository_Class__Singleton = New AreaRepository_Class End If Set AreaRepository = AreaRepository_Class__Singleton End Function %>