dcovington
/
Prospecting


			
				
					
						
						
							
							<%
'=======================================================================================================================
' 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
%>