Attribute VB_Name = "handler"
Option Explicit

Public sql As String
Public jsql As String
Public scenario As String
Public sc() As Variant
Public data() As String
Public agg() As String
Public showprice As Boolean
Public server As String
Public plan As String
Public basis() As Variant
Public baseline() As Variant
Public adjust() As Variant


Sub load_fpvt()

    Application.StatusBar = "retrieving selection data....."

    Dim i As Long
    Dim s_tot As Object

    fpvt.lbSDET.list = handler.sc

    showprice = False

    For i = 0 To UBound(handler.sc, 1)
        If handler.sc(i, 0) = "part_descr" Then
            showprice = True
            Exit For
        End If
    Next i


    fpvt.Show



End Sub

Function scenario_package(doc As String, ByRef status As Boolean) As Object

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String

    On Error GoTo errh

    With req
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
        .Open "GET", server & "/scenario_package", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        Debug.Print "GET /scenario_package (";
        Dim t As Single
        t = Timer
        .WaitForResponse
        wr = .ResponseText
        Debug.Print Timer - t; "sec): "; Left(wr, 200)
    End With

    Set json = JsonConverter.ParseJson(wr)
    Set scenario_package = json

errh:
    If Err.Number <> 0 Then
        status = False
        MsgBox (Err.Description)
        Set scenario_package = Nothing
    Else
        status = True
    End If

End Function


Sub pg_main_workset(catg As String, rep As String)

    Dim req As New WinHttp.WinHttpRequest
    Dim wr As String
    Dim json As Object
    Dim doc As String
    Dim res() As Variant

    doc = "{""scenario"":{""" & catg & """:""" & rep & """}}"

    Application.StatusBar = "Querying for " & rep & "'s pool of data..."
    With req
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
        .Open "GET", handler.server & "/get_pool", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        Debug.Print "GET /get_pool (";
        Dim t As Single
        t = Timer
        .WaitForResponse
        wr = .ResponseText
        Debug.Print Timer - t; "sec): "; Left(wr, 200)
    End With

    If Mid(wr, 1, 1) <> "{" Then
        MsgBox (wr)
        Exit Sub
    End If

    Application.StatusBar = "Parsing query results..."
    Set json = JsonConverter.ParseJson(wr)

    If IsNull(json("x")) Then
        MsgBox "No data found for " & rep & "."
        Exit Sub
    End If

    ReDim res(0, 34)
    res(0, 0) = "bill_cust_descr"
    res(0, 1) = "billto_group"
    res(0, 2) = "ship_cust_descr"
    res(0, 3) = "shipto_group"
    res(0, 4) = "quota_rep_descr"
    res(0, 5) = "director"
    res(0, 6) = "segm"
    res(0, 7) = "substance"
    res(0, 8) = "chan"
    res(0, 9) = "chansub"
    res(0, 10) = "part_descr"
    res(0, 11) = "part_group"
    res(0, 12) = "branding"
    res(0, 13) = "majg_descr"
    res(0, 14) = "ming_descr"
    res(0, 15) = "majs_descr"
    res(0, 16) = "mins_descr"
    res(0, 17) = "order_season"
    res(0, 18) = "order_month"
    res(0, 19) = "ship_season"
    res(0, 20) = "ship_month"
    res(0, 21) = "request_season"
    res(0, 22) = "request_month"
    res(0, 23) = "promo"
    res(0, 24) = "value_loc"
    res(0, 25) = "value_usd"
    res(0, 26) = "cost_loc"
    res(0, 27) = "cost_usd"
    res(0, 28) = "units"
    res(0, 29) = "version"
    res(0, 30) = "iter"
    res(0, 31) = "logid"
    res(0, 32) = "tag"
    res(0, 33) = "comment"
    res(0, 34) = "pounds"

    shData.Cells.ClearContents
    Call Utils.SHTp_DumpVar(res, shData.Name, 1, 1, False, True, True)

    Dim batchSize As Integer
    batchSize = 1000
    Dim totalRows As Long
    totalRows = json("x").Count
    Dim jsonRow As Long
    jsonRow = 1
    Dim sheetRow As Long
    sheetRow = 2
    Dim arrayRow As Long

    ' While the JSON array still has rows,
    '   1. move the 1st one to a VBA 2-D array, deleting it from the JSON array.
    '   2. When 1000 have been copied, put the values onto the worksheet, and
    '      empty the VBA array.
    ' Splitting the JSON array into smaller batches when creating the VBA array
    ' means there is less memory needed for the operation.
    Do While json("x").Count > 0
        If jsonRow Mod batchSize = 1 Then
            ReDim res(batchSize - 1, 34)
            arrayRow = 0
        End If
        res(arrayRow, 0) = json("x")(1)("bill_cust_descr")
        res(arrayRow, 1) = json("x")(1)("billto_group")
        res(arrayRow, 2) = json("x")(1)("ship_cust_descr")
        res(arrayRow, 3) = json("x")(1)("shipto_group")
        res(arrayRow, 4) = json("x")(1)("quota_rep_descr")
        res(arrayRow, 5) = json("x")(1)("director")
        res(arrayRow, 6) = json("x")(1)("segm")
        res(arrayRow, 7) = json("x")(1)("substance")
        res(arrayRow, 8) = json("x")(1)("chan")
        res(arrayRow, 9) = json("x")(1)("chansub")
        res(arrayRow, 10) = json("x")(1)("part_descr")
        res(arrayRow, 11) = json("x")(1)("part_group")
        res(arrayRow, 12) = json("x")(1)("branding")
        res(arrayRow, 13) = json("x")(1)("majg_descr")
        res(arrayRow, 14) = json("x")(1)("ming_descr")
        res(arrayRow, 15) = json("x")(1)("majs_descr")
        res(arrayRow, 16) = json("x")(1)("mins_descr")
        res(arrayRow, 17) = json("x")(1)("order_season")
        res(arrayRow, 18) = json("x")(1)("order_month")
        res(arrayRow, 19) = json("x")(1)("ship_season")
        res(arrayRow, 20) = json("x")(1)("ship_month")
        res(arrayRow, 21) = json("x")(1)("request_season")
        res(arrayRow, 22) = json("x")(1)("request_month")
        res(arrayRow, 23) = json("x")(1)("promo")
        res(arrayRow, 24) = json("x")(1)("value_loc")
        res(arrayRow, 25) = json("x")(1)("value_usd")
        res(arrayRow, 26) = json("x")(1)("cost_loc")
        res(arrayRow, 27) = json("x")(1)("cost_usd")
        res(arrayRow, 28) = json("x")(1)("units")
        res(arrayRow, 29) = json("x")(1)("version")
        res(arrayRow, 30) = json("x")(1)("iter")
        res(arrayRow, 31) = json("x")(1)("logid")
        res(arrayRow, 32) = json("x")(1)("tag")
        res(arrayRow, 33) = json("x")(1)("comment")
        res(arrayRow, 34) = json("x")(1)("pounds")
        json("x").Remove 1
        arrayRow = arrayRow + 1
        If jsonRow Mod batchSize = 0 Or json("x").Count = 0 Then
            Application.StatusBar = "Populating spreadsheet: " & Format(jsonRow, "#,##0") & " of " & Format(totalRows, "#,##0") & " rows..."
            Call Utils.SHTp_DumpVar(res, shData.Name, sheetRow, 1, False, True, True)
            sheetRow = sheetRow + batchSize
        End If
        jsonRow = jsonRow + 1
    Loop

    Set json = Nothing
    Application.StatusBar = False
End Sub

Sub pull_rep()
    openf.Show
End Sub



Function request_adjust(doc As String, ByRef fail As Boolean) As Object

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    Dim i As Long
    Dim j As Long
    Dim str() As String

    If doc = "" Then
        fail = True
        Exit Function
    End If

    'update timestamp
    Set json = JsonConverter.ParseJson(doc)
    'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
    'doc = JsonConverter.ConvertToJson(doc)

    server = shConfig.Range("server").Value

    With req
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
        .Open "POST", server & "/" & json("type"), True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        Debug.Print "GET /"; json("type"); " (";
        Dim t As Single
        t = Timer
        .WaitForResponse
        wr = .ResponseText
        Debug.Print Timer - t; "sec): "; Left(wr, 200)
    End With

    If Mid(wr, 2, 5) = "error" Then
        MsgBox (wr)
        fail = True
        Exit Function
    End If

    If Mid(wr, 1, 6) = "<body>" Then
        MsgBox (wr)
        fail = True
        Exit Function
    End If

    If Mid(wr, 1, 6) = "<!DOCT" Then
        MsgBox (wr)
        fail = True
        Exit Function
    End If

    If Mid(wr, 1, 6) = "null" Then
        MsgBox ("API route not implemented")
        fail = True
        Exit Function
    End If

    Set json = JsonConverter.ParseJson(wr)

    If IsNull(json("x")) Then
        MsgBox ("No adjustment was made.")
        fail = False
        Exit Function
    End If

    ReDim res(json("x").Count - 1, 34)

    For i = 0 To UBound(res, 1)
        res(i, 0) = json("x")(i + 1)("bill_cust_descr")
        res(i, 1) = json("x")(i + 1)("billto_group")
        res(i, 2) = json("x")(i + 1)("ship_cust_descr")
        res(i, 3) = json("x")(i + 1)("shipto_group")
        res(i, 4) = json("x")(i + 1)("quota_rep_descr")
        res(i, 5) = json("x")(i + 1)("director")
        res(i, 6) = json("x")(i + 1)("segm")
        res(i, 7) = json("x")(i + 1)("substance")
        res(i, 8) = json("x")(i + 1)("chan")
        res(i, 9) = json("x")(i + 1)("chansub")
        res(i, 10) = json("x")(i + 1)("part_descr")
        res(i, 11) = json("x")(i + 1)("part_group")
        res(i, 12) = json("x")(i + 1)("branding")
        res(i, 13) = json("x")(i + 1)("majg_descr")
        res(i, 14) = json("x")(i + 1)("ming_descr")
        res(i, 15) = json("x")(i + 1)("majs_descr")
        res(i, 16) = json("x")(i + 1)("mins_descr")
        res(i, 17) = json("x")(i + 1)("order_season")
        res(i, 18) = json("x")(i + 1)("order_month")
        res(i, 19) = json("x")(i + 1)("ship_season")
        res(i, 20) = json("x")(i + 1)("ship_month")
        res(i, 21) = json("x")(i + 1)("request_season")
        res(i, 22) = json("x")(i + 1)("request_month")
        res(i, 23) = json("x")(i + 1)("promo")
        res(i, 24) = json("x")(i + 1)("value_loc")
        res(i, 25) = json("x")(i + 1)("value_usd")
        res(i, 26) = json("x")(i + 1)("cost_loc")
        res(i, 27) = json("x")(i + 1)("cost_usd")
        res(i, 28) = json("x")(i + 1)("units")
        res(i, 29) = json("x")(i + 1)("version")
        res(i, 30) = json("x")(i + 1)("iter")
        res(i, 31) = json("x")(i + 1)("logid")
        res(i, 32) = json("x")(i + 1)("tag")
        res(i, 33) = json("x")(i + 1)("comment")
        res(i, 34) = json("x")(i + 1)("pounds")
    Next i

    Set json = Nothing

    ReDim str(UBound(res, 1), UBound(res, 2))

'    For i = 0 To UBound(res, 1)
'        For j = 0 To UBound(res, 2)
'            If IsNull(res(i, j)) Then
'                str(i, j) = ""
'            Else
'                str(i, j) = res(i, j)
'            End If
'        Next j
'    Next i

    i = 1
    Do Until shData.Cells(i, 1) = ""
        i = i + 1
    Loop

    Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)


    'Call Utils.SHTp_Dump(str, shData.Name, CLng(i), 1, False, False, 28, 29, 30, 31, 32)

    shOrders.PivotTables("ptOrders").PivotCache.Refresh

End Function

Sub load_config()

    Dim i As Integer
    '----server to use---------------------------------------------------------
    handler.server = shConfig.Range("server").Value
    '---basis-----------------------------------------------------------------
    With shConfig.ListObjects("BASIS")
        For i = 1 To .DataBodyRange.Rows.Count
            ReDim Preserve handler.basis(i - 1)
            handler.basis(i - 1) = .DataBodyRange(i, 1)
        Next
    End With
    '---baseline-----------------------------------------------------------------
    With shConfig.ListObjects("BASELINE")
        For i = 1 To .DataBodyRange.Rows.Count
            ReDim Preserve handler.baseline(i - 1)
            handler.baseline(i - 1) = .DataBodyRange(i, 1)
        Next
    End With
    '---adjustments-----------------------------------------------------------------
    With shConfig.ListObjects("ADJUST")
        For i = 1 To .DataBodyRange.Rows.Count
            ReDim Preserve handler.adjust(i - 1)
            handler.adjust(i - 1) = .DataBodyRange(i, 1)
        Next
    End With
    '---plan version--------------------------------------------------------------
    handler.plan = shConfig.Range("budget").Value

End Sub

Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)

    Dim j As Object
    Dim i As Integer
    Dim r As Long

    With shMonthUpdate

        Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
        .Cells(1, 16) = JsonConverter.ConvertToJson(j)

        For i = 1 To 12
            '------------volume-------------------
            .Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
            .Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
            .Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
            .Cells(i + 1, 4) = 0
            .Cells(i + 1, 5) = co_num(pkg(i, 4), 0)

            '------------value----------------------
            .Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
            .Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
            .Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
            .Cells(i + 1, 14) = 0
            .Cells(i + 1, 15) = co_num(pkg(i, 8), 0)

            '-------------price----------------------
            If i > 0 Then
                '--prior--
                If co_num(pkg(i, 1), 0) = 0 Then
                    .Cells(i + 1, 6) = 0
                Else
                    .Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
                End If

                '--base--
                If co_num(pkg(i, 2), 0) = 0 Then
                    'if there is no monthly base volume,
                    'then use the prior price, if there was no prior price,
                    'then inherit the average price for the year before current adjustments
                    If .Cells(i, 7) <> 0 Then
                        .Cells(i + 1, 7) = .Cells(i, 7)
                    Else
                        If pkg(13, 1) + pkg(13, 2) = 0 Then
                            .Cells(i + 1, 7) = 0
                        Else
                            .Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
                        End If
                    End If
                Else
                    .Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
                End If

                '--adjust--
                If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
                    .Cells(i + 1, 8) = 0
                Else
                    .Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
                End If

                '--current adjust--
                .Cells(i + 1, 9) = 0

                '--forecast--
                If co_num(pkg(i, 4), 0) = 0 Then
                    'if there is no monthly base volume,
                    'then use the prior price, if there was no prior price,
                    'then inherit the average price for the year before current adjustments
                    If .Cells(i, 10) <> 0 Then
                        .Cells(i + 1, 10) = .Cells(i, 10)
                    Else
                        If pkg(13, 1) + pkg(13, 2) = 0 Then
                            .Cells(i + 1, 10) = 0
                        Else
                            .Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
                        End If
                    End If
                Else
                    .Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
                End If

            End If

        Next i

        'scenario
        .Range("R1:S1000").ClearContents
        For i = 0 To UBound(handler.sc, 1)
            .Cells(i + 1, 18) = handler.sc(i, 0)
            .Cells(i + 1, 19) = handler.sc(i, 1)
        Next i

        'basket
        .Range("U1:AC100000").ClearContents
        Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True)
        Call Utils.SHTp_DumpVar(basket, .Name, 1, 26, False, False, True)
        shConfig.Range("rebuild").Value = 0
        shConfig.Range("show_basket").Value = 0
        shConfig.Range("new_part").Value = 0

        shMonthView.LoadSheet

    End With

End Sub

Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant

    If one = "" Or IsNull(one) Then
        co_num = two
    Else
        co_num = one
    End If

End Function


Function list_changes(doc As String, ByRef fail As Boolean) As Variant()

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    Dim i As Long
    Dim j As Long
    Dim res() As Variant

    If doc = "" Then
        fail = True
        Exit Function
    End If

    server = shConfig.Range("server").Value

    With req
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
        .Open "GET", server & "/list_changes", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        Debug.Print "GET /list_changes (";
        Dim t As Single
        t = Timer
        .WaitForResponse
        wr = .ResponseText
        Debug.Print Timer - t; "sec): "; Left(wr, 200)
    End With

    Set json = JsonConverter.ParseJson(wr)

    If IsNull(json("x")) Then
        MsgBox ("No history.")
        fail = True
        Exit Function
    End If

    ReDim res(json("x").Count - 1, 7)

    For i = 0 To UBound(res, 1)
        res(i, 0) = json("x")(i + 1)("user")
        res(i, 1) = json("x")(i + 1)("quota_rep_descr")
        res(i, 2) = json("x")(i + 1)("stamp")
        res(i, 3) = json("x")(i + 1)("tag")
        res(i, 4) = json("x")(i + 1)("comment")
        res(i, 5) = json("x")(i + 1)("sales")
        res(i, 6) = json("x")(i + 1)("id")
        res(i, 7) = json("x")(i + 1)("doc")
    Next i

    list_changes = res

End Function

Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant()

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    Dim i As Long
    Dim j As Long
    Dim res() As Variant
    Dim doc As String
    Dim ds As Worksheet

    doc = "{""logid"":" & logid & "}"

    server = handler.server

    With req
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
        .Open "GET", server & "/undo_change", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        Debug.Print "GET /undo_change (";
        Dim t As Single
        t = Timer
        .WaitForResponse
        wr = .ResponseText
        Debug.Print Timer - t; "sec): "; Left(wr, 200)
    End With

    Set json = JsonConverter.ParseJson(wr)
    logid = json("x")(1)("id")

    '---------loop through and get a list of each row that needs deleted?-----

    j = 0
    For i = 1 To 100
        If shData.Cells(1, i) = "logid" Then
            j = i
            Exit For
        End If
    Next i

    If j = 0 Then
        MsgBox ("Current data set is not tracking changes. Cannot isolate change locally.")
        fail = True
        Exit Function
    End If

    i = 2
    With shData
        While .Cells(i, 1) <> ""
            If .Cells(i, j) = logid Then
                .Rows(i).Delete
            Else
                i = i + 1
            End If
        Wend
    End With

End Function


Sub history()

    changes.Show

End Sub

Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()

    Dim req As New WinHttp.WinHttpRequest
    Dim json As Object
    Dim wr As String
    Dim i As Integer
    Dim j As Integer
    Dim res() As Variant

    If doc = "" Then
        fail = True
        Exit Function
    End If

    server = shConfig.Range("server").Value

    With req
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
        .Open "GET", server & "/swap_fit", True
        .SetRequestHeader "Content-Type", "application/json"
        .Send doc
        Debug.Print "GET /swap_fit (";
        Dim t As Single
        t = Timer
        .WaitForResponse
        wr = .ResponseText
        Debug.Print Timer - t; "sec): "; Left(wr, 200)
    End With

    Set json = JsonConverter.ParseJson(wr)

    If IsNull(json("x")) Then
        MsgBox ("No history.")
        fail = True
        Exit Function
    End If

    ReDim res(json("x").Count - 1, 3)

    For i = 0 To UBound(res, 1)
        res(i, 0) = json("x")(i + 1)("part")
        res(i, 1) = json("x")(i + 1)("value_usd")
        res(i, 2) = json("x")(i + 1)("swap")
        res(i, 3) = json("x")(i + 1)("fit")
    Next i

    get_swap_fit = res

End Function