diff --git a/VBA/build.frx b/VBA/build.frx index d7da264..c85abb2 100644 Binary files a/VBA/build.frx and b/VBA/build.frx differ diff --git a/VBA/changes.frx b/VBA/changes.frx index 9e92f81..d1202a7 100644 Binary files a/VBA/changes.frx and b/VBA/changes.frx differ diff --git a/VBA/fpvt.frx b/VBA/fpvt.frx index 2825156..5930f72 100644 Binary files a/VBA/fpvt.frx and b/VBA/fpvt.frx differ diff --git a/VBA/handler.bas b/VBA/handler.bas index 32d4a7e..aa99c66 100644 --- a/VBA/handler.bas +++ b/VBA/handler.bas @@ -18,24 +18,24 @@ 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 @@ -45,21 +45,25 @@ 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 @@ -68,82 +72,48 @@ errh: Else status = True End If - + End Function -Sub pg_main_workset(rep As String) + +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 i As Long - Dim j As Long Dim doc As String Dim res() As Variant - Dim str() As String + + doc = "{""scenario"":{""" & catg & """:""" & rep & """}}" - doc = "{""quota_rep"":""" & 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(json("x").Count, 34) - - For i = 1 To UBound(res, 1) - res(i, 0) = json("x")(i)("bill_cust_descr") - res(i, 1) = json("x")(i)("billto_group") - res(i, 2) = json("x")(i)("ship_cust_descr") - res(i, 3) = json("x")(i)("shipto_group") - res(i, 4) = json("x")(i)("quota_rep_descr") - res(i, 5) = json("x")(i)("director") - res(i, 6) = json("x")(i)("segm") - res(i, 7) = json("x")(i)("substance") - res(i, 8) = json("x")(i)("chan") - res(i, 9) = json("x")(i)("chansub") - res(i, 10) = json("x")(i)("part_descr") - res(i, 11) = json("x")(i)("part_group") - res(i, 12) = json("x")(i)("branding") - res(i, 13) = json("x")(i)("majg_descr") - res(i, 14) = json("x")(i)("ming_descr") - res(i, 15) = json("x")(i)("majs_descr") - res(i, 16) = json("x")(i)("mins_descr") - res(i, 17) = json("x")(i)("order_season") - res(i, 18) = json("x")(i)("order_month") - res(i, 19) = json("x")(i)("ship_season") - res(i, 20) = json("x")(i)("ship_month") - res(i, 21) = json("x")(i)("request_season") - res(i, 22) = json("x")(i)("request_month") - res(i, 23) = json("x")(i)("promo") - res(i, 24) = json("x")(i)("value_loc") - res(i, 25) = json("x")(i)("value_usd") - res(i, 26) = json("x")(i)("cost_loc") - res(i, 27) = json("x")(i)("cost_usd") - res(i, 28) = json("x")(i)("units") - res(i, 29) = json("x")(i)("version") - res(i, 30) = json("x")(i)("iter") - res(i, 31) = json("x")(i)("logid") - res(i, 32) = json("x")(i)("tag") - res(i, 33) = json("x")(i)("comment") - res(i, 34) = json("x")(i)("pounds") - Next i - + + ReDim res(0, 34) res(0, 0) = "bill_cust_descr" res(0, 1) = "billto_group" res(0, 2) = "ship_cust_descr" @@ -179,21 +149,82 @@ Sub pg_main_workset(rep As String) res(0, 32) = "tag" res(0, 33) = "comment" res(0, 34) = "pounds" - - Set json = Nothing - ReDim str(UBound(res, 1), UBound(res, 2)) - 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 @@ -206,46 +237,50 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object 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) = "" Then MsgBox (wr) fail = True Exit Function End If - + If Mid(wr, 1, 6) = " 0 Then '--prior-- @@ -393,7 +428,7 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant) 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, @@ -411,17 +446,17 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant) 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, @@ -439,18 +474,18 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant) 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) @@ -458,11 +493,11 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant) 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 @@ -484,33 +519,37 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant() 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 & "/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") @@ -521,7 +560,7 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant() res(i, 6) = json("x")(i + 1)("id") res(i, 7) = json("x")(i + 1)("doc") Next i - + list_changes = res End Function @@ -536,25 +575,29 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant( 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 @@ -562,13 +605,13 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant( 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) <> "" @@ -597,40 +640,47 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant() 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 + + + diff --git a/VBA/openf.frm b/VBA/openf.frm index 398c913..0f6ca9d 100644 --- a/VBA/openf.frm +++ b/VBA/openf.frm @@ -1,10 +1,10 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf Caption = "Open a Forecast" - ClientHeight = 1365 + ClientHeight = 2400 ClientLeft = 120 ClientTop = 465 - ClientWidth = 6825 + ClientWidth = 8220.001 OleObjectBlob = "openf.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -14,27 +14,44 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub cbCancel_Click() - openf.Hide - End Sub Private Sub cbOK_Click() - - Application.StatusBar = "Retrieving data for " & cbDSM.Value & "....." - - openf.Caption = "Retrieving data......" - Call handler.pg_main_workset(cbDSM.Value) + If opDSM.Value Then + Call handler.pg_main_workset("quota_rep_descr", cbDSM.Value) + ElseIf opDirector.Value Then + Call handler.pg_main_workset("director", cbDirector.Value) + ElseIf opSegment.Value Then + Call handler.pg_main_workset("segm", cbSegment.Value) + End If shOrders.PivotTables("ptOrders").PivotCache.Refresh - Application.StatusBar = False openf.Hide +End Sub +Private Sub opDSM_Click() + cbDSM.Enabled = True + cbDirector.Enabled = False + cbSegment.Enabled = False +End Sub + +Private Sub opDirector_Click() + cbDSM.Enabled = False + cbDirector.Enabled = True + cbSegment.Enabled = False +End Sub + +Private Sub opSegment_Click() + cbDSM.Enabled = False + cbDirector.Enabled = False + cbSegment.Enabled = True End Sub Private Sub UserForm_Activate() - handler.server = shConfig.Range("server").Value cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.Value - + cbDirector.list = shConfig.ListObjects("DIRECTORS").DataBodyRange.Value + cbSegment.list = shConfig.ListObjects("SEGMENTS").DataBodyRange.Value End Sub + diff --git a/VBA/openf.frx b/VBA/openf.frx index 46418b7..42b20ba 100644 Binary files a/VBA/openf.frx and b/VBA/openf.frx differ diff --git a/VBA/part.frx b/VBA/part.frx index 0a855b7..7d15813 100644 Binary files a/VBA/part.frx and b/VBA/part.frx differ diff --git a/index.js b/index.js index a4bf6c5..803900c 100644 --- a/index.js +++ b/index.js @@ -75,14 +75,30 @@ server.get('/test_sql', function(req, res) { server.get('/get_pool', bodyParser.json(), function(req, res) { var sql = ""; - var args = [req.body.quota_rep]; + var w = ""; + var c = 1; + var d = 1; + var args = []; var path = './route_sql/get_pool.sql'; console.log(`${new Date().toISOString()}: GET /get_pool (Get all data for one DSM.)... SQL: ${path} ${"-._.".repeat(20)}`); var callback = function(arg) { sql = arg; - console.log(req.body.quota_rep); - sql = sql.replace("rep_replace", req.body.quota_rep); + + if (req.body.quota_rep) { + // ensure backward compatibility + console.log('Converting old format...', req.body); + req.body = {'scenario':{'quota_rep_descr':req.body.quota_rep}}; + } + + ({ c, w, d } = build_where(req, c, w, d, args)); + + if (c == 1) { + res.send("no body was sent"); + return; + } + console.log(req.body); + sql = sql.replace(new RegExp("where_clause", 'g'), w); console.log(sql); Postgres.FirstRow(sql, [], res) }; @@ -668,8 +684,8 @@ server.post('/new_basket', bodyParser.json(), function(req, res) { function build_where(req, c, w, d, args) { for (var i in req.body.scenario) { - //console.log(i); - ///console.log(req.body[i]); + // console.log(i); + // console.log(req.body[i]); if (c > 1) { w = w + ` diff --git a/route_sql/get_pool.sql b/route_sql/get_pool.sql index 6465358..de675c6 100644 --- a/route_sql/get_pool.sql +++ b/route_sql/get_pool.sql @@ -45,7 +45,7 @@ SELECT FROM rlarp.osm_pool WHERE - quota_rep_descr = 'rep_replace' + where_clause GROUP BY ---------customer info----------------- bill_cust_descr