Attribute VB_Name = "Veacon"
'
' Veacon — Korean institutional CRE data, accessible from any Excel cell.
' v0.1.1 — late-bound DocumentProperties + literal Optional defaults.
' ---------------------------------------------------------------------
'
' Setup (one time):
'   1. File → Options → Trust Center → Trust Center Settings → Macro Settings
'      → "메크로 포함 모든 파일에 대해 알림 표시" 또는 enable.
'   2. Press Alt+F11 to open VBA editor.
'   3. **이미 Veacon / Veacon1 모듈이 있다면 먼저 삭제** (우클릭 → 제거 →
'      "Export?" No). 중복 모듈은 ambiguous-name / compile-cascade 에러 유발.
'   4. File → Import File → select Veacon.bas. 모듈 트리에 Veacon 만 보여야 함.
'   5. In the Immediate window (Ctrl+G), run once:
'        VEACON_SET_KEY "veacon_pk_live_..."
'      issue free key at https://veacon.io/dashboard (Starter month 10,000).
'   6. 워크북 저장 (Ctrl+S) — 키가 CustomDocumentProperty 에 보존.
'
' Use in any cell:
'   =VEACON_PING()                                    smoke test (no args)
'   =VEACON_MEDIAN("11680","office","sale")           RTMS median
'   =VEACON_P25("11680","office","sale")
'   =VEACON_P75("11680","office","sale")
'   =VEACON_SAMPLE_COUNT("11680","office","sale")
'   =VEACON_CONFIDENCE("11680","office","sale")       low/medium/high
'   =VEACON_CAP_RATE("11680","office")                R-ONE annualized cap rate %
'   =VEACON_VACANCY_RATE("11680","office")            R-ONE vacancy rate %
'
' Cache: identical (sigungu, property, period) calls within a workbook
'   session return cached values. Force refresh: VEACON_CLEAR_CACHE() + F9.
'
' Source:  https://github.com/eric-yoon12/veacon/tree/main/public/excel
' Docs:    https://veacon.io/excel
' Support: hello@veacon.io
'

Option Explicit

Private Const VEACON_BASE_URL As String = "https://veacon.io"
Private Const VEACON_KEY_PROP As String = "Veacon.ApiKey"
Private Const VEACON_USER_AGENT As String = "veacon-excel/0.1.1"

' msoPropertyTypeString (Office.MsoDocProperties enum value 4). Hardcoded
' to avoid requiring a Microsoft Office Object Library reference — module
' compiles on any Excel install, not just those with Office.MSO loaded.
Private Const MSO_PROPERTY_TYPE_STRING As Long = 4

Private cache As Object  ' Scripting.Dictionary, initialized lazily.

' ============================================================================
' PUBLIC API
' ============================================================================

Public Function VEACON_SET_KEY(ByVal apiKey As String) As String
    On Error GoTo Err_
    Dim props As Object  ' Office.DocumentProperties (late-bound for portability)
    Set props = ThisWorkbook.CustomDocumentProperties
    On Error Resume Next
    props(VEACON_KEY_PROP).Delete
    On Error GoTo Err_
    props.Add Name:=VEACON_KEY_PROP, LinkToContent:=False, _
              Type:=MSO_PROPERTY_TYPE_STRING, Value:=apiKey
    clearCache
    VEACON_SET_KEY = "OK — key stored in workbook properties. Save the file (Ctrl+S) to persist."
    Exit Function
Err_:
    VEACON_SET_KEY = "ERROR: " & Err.Description
End Function

Public Function VEACON_PING() As String
    On Error GoTo Err_
    Dim url As String
    url = VEACON_BASE_URL & "/api/v1/real-estate/coverage"
    Dim status As Long, headers As String, body As String
    httpGet url, status, headers, body
    If status >= 200 And status < 300 Then
        VEACON_PING = "OK — connected to veacon.io. " & extractRateLimit(headers)
    Else
        VEACON_PING = "ERROR " & status & ": " & Left$(body, 200)
    End If
    Exit Function
Err_:
    VEACON_PING = "ERROR: " & Err.Description
End Function

Public Function VEACON_CLEAR_CACHE() As String
    clearCache
    VEACON_CLEAR_CACHE = "OK — cache cleared. Press F9 to recalculate."
End Function

Public Function VEACON_MEDIAN(sigungu As String, propertyType As String, _
                              transactionType As String, _
                              Optional period As String = "last_6m") As Variant
    VEACON_MEDIAN = pulseField(sigungu, propertyType, transactionType, period, "median_price")
End Function

Public Function VEACON_P25(sigungu As String, propertyType As String, _
                           transactionType As String, _
                           Optional period As String = "last_6m") As Variant
    VEACON_P25 = pulseField(sigungu, propertyType, transactionType, period, "p25_price")
End Function

Public Function VEACON_P75(sigungu As String, propertyType As String, _
                           transactionType As String, _
                           Optional period As String = "last_6m") As Variant
    VEACON_P75 = pulseField(sigungu, propertyType, transactionType, period, "p75_price")
End Function

Public Function VEACON_SAMPLE_COUNT(sigungu As String, propertyType As String, _
                                    transactionType As String, _
                                    Optional period As String = "last_6m") As Variant
    VEACON_SAMPLE_COUNT = pulseField(sigungu, propertyType, transactionType, period, "sample_count")
End Function

Public Function VEACON_CONFIDENCE(sigungu As String, propertyType As String, _
                                  transactionType As String, _
                                  Optional period As String = "last_6m") As Variant
    VEACON_CONFIDENCE = pulseField(sigungu, propertyType, transactionType, period, "confidence")
End Function

Public Function VEACON_CAP_RATE(sigungu As String, propertyType As String, _
                                Optional period As String = "last_4q") As Variant
    VEACON_CAP_RATE = indexField(sigungu, propertyType, "capital_yield", period, "annualized_cap_rate_pct")
End Function

Public Function VEACON_VACANCY_RATE(sigungu As String, propertyType As String, _
                                    Optional period As String = "last_4q") As Variant
    VEACON_VACANCY_RATE = indexField(sigungu, propertyType, "vacancy_rate", period, "value_pct")
End Function

' ============================================================================
' INTERNALS
' ============================================================================

Private Function pulseField(sigungu As String, propertyType As String, _
                            transactionType As String, period As String, _
                            fieldName As String) As Variant
    On Error GoTo Err_
    Dim url As String
    url = VEACON_BASE_URL & "/api/v1/real-estate/pulse" & _
          "?sigungu_code=" & urlEncode(sigungu) & _
          "&property_type=" & urlEncode(propertyType) & _
          "&transaction_type=" & urlEncode(transactionType) & _
          "&period=" & urlEncode(period) & _
          "&format=csv"
    pulseField = fetchCsvField(url, fieldName)
    Exit Function
Err_:
    pulseField = CVErr(xlErrValue)
End Function

Private Function indexField(sigungu As String, propertyType As String, _
                            metricType As String, period As String, _
                            fieldName As String) As Variant
    On Error GoTo Err_
    Dim url As String
    url = VEACON_BASE_URL & "/api/v1/real-estate/indices" & _
          "?sigungu_code=" & urlEncode(sigungu) & _
          "&property_type=" & urlEncode(propertyType) & _
          "&metric_type=" & urlEncode(metricType) & _
          "&period=" & urlEncode(period) & _
          "&format=csv"
    indexField = fetchCsvField(url, fieldName)
    Exit Function
Err_:
    indexField = CVErr(xlErrValue)
End Function

Private Function fetchCsvField(url As String, fieldName As String) As Variant
    On Error GoTo Err_
    Dim cached As String
    cached = getCached(url)
    Dim csv As String
    If Len(cached) > 0 Then
        csv = cached
    Else
        Dim status As Long, headers As String, body As String
        httpGet url, status, headers, body
        If status < 200 Or status >= 300 Then
            fetchCsvField = CVErr(xlErrValue)
            Exit Function
        End If
        csv = body
        putCached url, csv
    End If
    fetchCsvField = csvFirstRowField(csv, fieldName)
    Exit Function
Err_:
    fetchCsvField = CVErr(xlErrValue)
End Function

Private Sub httpGet(ByVal url As String, ByRef status As Long, _
                    ByRef headers As String, ByRef body As String)
    On Error GoTo Err_
    Dim apiKey As String
    apiKey = getApiKey()
    If Len(apiKey) = 0 Then
        status = 401
        body = "no API key — call VEACON_SET_KEY first"
        Exit Sub
    End If
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "GET", url, False
    http.SetRequestHeader "X-API-Key", apiKey
    http.SetRequestHeader "Accept", "text/csv"
    http.SetRequestHeader "User-Agent", VEACON_USER_AGENT
    http.send
    status = http.status
    headers = http.GetAllResponseHeaders()
    body = http.responseText
    Exit Sub
Err_:
    status = 0
    body = "VBA error: " & Err.Description
End Sub

Private Function getApiKey() As String
    On Error Resume Next
    getApiKey = ""
    getApiKey = ThisWorkbook.CustomDocumentProperties(VEACON_KEY_PROP).Value
    On Error GoTo 0
End Function

' Percent-encode per RFC 3986. Korean characters → UTF-8 bytes → %XX hex.
' Pure VBA — no library dependency.
Private Function urlEncode(ByVal s As String) As String
    Dim i As Long, ch As String, code As Long, out As String
    Dim bytes() As Byte
    Dim j As Long
    For i = 1 To Len(s)
        ch = Mid$(s, i, 1)
        code = AscW(ch)
        If code < 0 Then code = code + 65536  ' AscW signed
        If (code >= 48 And code <= 57) Or _
           (code >= 65 And code <= 90) Or _
           (code >= 97 And code <= 122) Or _
           ch = "-" Or ch = "_" Or ch = "." Or ch = "~" Then
            out = out & ch
        Else
            bytes = ToUtf8Bytes(code)
            For j = 0 To UBound(bytes)
                out = out & "%" & Right$("0" & Hex$(bytes(j)), 2)
            Next j
        End If
    Next i
    urlEncode = out
End Function

Private Function ToUtf8Bytes(ByVal cp As Long) As Byte()
    ' Convert a Unicode code point (BMP) to its UTF-8 byte sequence.
    Dim out() As Byte
    If cp < &H80 Then
        ReDim out(0)
        out(0) = cp
    ElseIf cp < &H800 Then
        ReDim out(1)
        out(0) = &HC0 Or (cp \ &H40)
        out(1) = &H80 Or (cp And &H3F)
    Else
        ReDim out(2)
        out(0) = &HE0 Or (cp \ &H1000)
        out(1) = &H80 Or ((cp \ &H40) And &H3F)
        out(2) = &H80 Or (cp And &H3F)
    End If
    ToUtf8Bytes = out
End Function

' Parse a UTF-8-BOM CSV with header row. Return value at named field in
' the first data row. Numeric strings coerce to Double; empty → #N/A.
Private Function csvFirstRowField(csv As String, fieldName As String) As Variant
    On Error GoTo Err_
    If Left$(csv, 1) = ChrW(&HFEFF) Then csv = Mid$(csv, 2)
    Dim lines() As String
    lines = Split(csv, vbLf)
    If UBound(lines) < 1 Then
        csvFirstRowField = CVErr(xlErrNA)
        Exit Function
    End If
    Dim headers() As String, values() As String
    headers = parseCsvLine(stripCr(lines(0)))
    values = parseCsvLine(stripCr(lines(1)))
    Dim i As Long
    For i = LBound(headers) To UBound(headers)
        If StrComp(headers(i), fieldName, vbTextCompare) = 0 Then
            If i <= UBound(values) Then
                Dim v As String
                v = values(i)
                If Len(v) = 0 Then
                    csvFirstRowField = CVErr(xlErrNA)
                ElseIf IsNumeric(v) Then
                    csvFirstRowField = CDbl(v)
                Else
                    csvFirstRowField = v
                End If
                Exit Function
            End If
        End If
    Next i
    csvFirstRowField = CVErr(xlErrNA)
    Exit Function
Err_:
    csvFirstRowField = CVErr(xlErrValue)
End Function

Private Function stripCr(s As String) As String
    If Right$(s, 1) = vbCr Then
        stripCr = Left$(s, Len(s) - 1)
    Else
        stripCr = s
    End If
End Function

Private Function parseCsvLine(line As String) As String()
    Dim result() As String
    ReDim result(0)
    Dim i As Long, ch As String
    Dim inQuotes As Boolean, current As String
    Dim n As Long
    n = 0
    inQuotes = False
    current = ""
    For i = 1 To Len(line)
        ch = Mid$(line, i, 1)
        If ch = """" Then
            inQuotes = Not inQuotes
        ElseIf ch = "," And Not inQuotes Then
            result(n) = current
            n = n + 1
            ReDim Preserve result(n)
            current = ""
        Else
            current = current & ch
        End If
    Next i
    result(n) = current
    parseCsvLine = result
End Function

Private Function extractRateLimit(headers As String) As String
    Dim quotaUsed As String, quotaLimit As String
    quotaUsed = headerValue(headers, "X-Quota-Used")
    quotaLimit = headerValue(headers, "X-Quota-Limit")
    If Len(quotaLimit) > 0 Then
        extractRateLimit = "Quota " & quotaUsed & "/" & quotaLimit & " this month."
    Else
        extractRateLimit = ""
    End If
End Function

Private Function headerValue(headers As String, headerName As String) As String
    Dim idx As Long
    idx = InStr(1, headers, headerName & ":", vbTextCompare)
    If idx = 0 Then
        headerValue = ""
        Exit Function
    End If
    Dim startPos As Long, endPos As Long
    startPos = idx + Len(headerName) + 1
    endPos = InStr(startPos, headers, vbCrLf)
    If endPos = 0 Then endPos = Len(headers) + 1
    headerValue = Trim$(Mid$(headers, startPos, endPos - startPos))
End Function

' ----- cache ---------------------------------------------------------------

Private Sub initCache()
    If cache Is Nothing Then
        Set cache = CreateObject("Scripting.Dictionary")
    End If
End Sub

Private Function getCached(url As String) As String
    initCache
    If cache.Exists(url) Then
        getCached = CStr(cache(url))
    Else
        getCached = ""
    End If
End Function

Private Sub putCached(url As String, value As String)
    initCache
    If cache.Exists(url) Then
        cache(url) = value
    Else
        cache.Add url, value
    End If
End Sub

Private Sub clearCache()
    Set cache = Nothing
End Sub