pt/forecast_api
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add options to query by director or segment. Also speed it up A LOT.

Browse Source
This commit is contained in:
PhilRunninger 2023-05-09 01:24:08 -04:00
parent cecd647ee7
commit eb03d61600
9 changed files with 227 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
VBA/build.frx
View File

Binary file not shown.

BIN
VBA/changes.frx
View File

Binary file not shown.

BIN
VBA/fpvt.frx
View File

Binary file not shown.

152
VBA/handler.bas
View File

@ -53,8 +53,12 @@ Function scenario_package(doc As String, ByRef status As Boolean) As Object
.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)
@ -71,32 +75,37 @@ errh:
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 = "{""quota_rep"":""" & rep & """}"
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
@ -104,46 +113,7 @@ Sub pg_main_workset(rep As String)
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"
@ -180,20 +150,81 @@ Sub pg_main_workset(rep As String)
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
@ -224,8 +255,12 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
.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
@ -497,8 +532,12 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
.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)
@ -546,8 +585,12 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
.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)
@ -610,8 +653,12 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
.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)
@ -634,3 +681,6 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
get_swap_fit = res
End Function

41
VBA/openf.frm
View File

@ -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

BIN
VBA/openf.frx
View File

Binary file not shown.

BIN
VBA/part.frx
View File

Binary file not shown.

26
index.js
View File

@ -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 +
`

2
route_sql/get_pool.sql
View File

@ -45,7 +45,7 @@ SELECT
FROM
rlarp.osm_pool
WHERE
quota_rep_descr = 'rep_replace'
where_clause
GROUP BY
---------customer info-----------------
bill_cust_descr