[PCOMM SCRIPT HEADER]
LANGUAGE=VBSCRIPT
DESCRIPTION=Update the UPC Scan catalog from AS/400 Item Entry
[PCOMM SCRIPT SOURCE]
Option Explicit
Const HOME_URL = "https://upc.ih8.us"
Const UPC_FIELD = "1,20,13"
Const COST_FIELD = "11,12,10"
Const SIZE_FIELD = "5,45,8"
Const DESC_FIELD = "5,8,30"

Function FieldText(ps, spec)
    Dim a
    a = Split(spec, ",")
    FieldText = Trim(ps.GetText(CInt(a(0)), CInt(a(1)), CInt(a(2))))
End Function

Function DigitsOnly(s)
    Dim re
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "^[0-9]{1,12}$"
    DigitsOnly = re.Test(s)
End Function

Function KeyOf(s)
    Do While Len(s) > 1 And Left(s,1) = "0"
        s = Mid(s,2)
    Loop
    KeyOf = s
End Function

Sub WaitReady(oia)
    oia.WaitForAppAvailable
    oia.WaitForInputReady
End Sub

Function ReadRetail(ps, oia, code)
    Dim originalVendor, changedVendor, price, validItem
    ReadRetail = ""
    price = ""
    changedVendor = False
    ps.SendKeys "[enter]"
    WaitReady oia
    If ps.GetText(3,2,4) <> "PVA:" Then
        If ps.GetText(1,2,10) <> "Item entry" Then Exit Function
        originalVendor = ps.GetText(1,45,6)
        ps.SetCursorPos 1,45
        ps.SendKeys "[erase eof]"
        oia.WaitForInputReady
        ps.SendKeys "8888"
        oia.WaitForInputReady
        changedVendor = True
        ps.SendKeys "[enter]"
        WaitReady oia
        ps.WaitForAttrib 3,6,"00","3c",3,10000
        ps.WaitForCursor 3,7,10000
        oia.WaitForInputReady
    End If
    If ps.GetText(3,2,4) = "PVA:" Then
        ps.SendKeys "[pf23]"
        ps.WaitForAttrib 21,19,"00","3c",3,10000
        ps.WaitForCursor 21,20,10000
        WaitReady oia
        If ps.GetText(19,3,16) <> "Price. . . . . ." Then Exit Function
        validItem = Trim(ps.GetText(7,20,13))
        If validItem <> "" And validItem <> "0000000000000" Then
            ps.SendKeys "[up]"
            oia.WaitForInputReady
            ps.SendKeys "[up]"
            oia.WaitForInputReady
            price = Trim(ps.GetText(19,20,17))
        End If
        ps.SendKeys "[pf3]"
        WaitReady oia
        ps.WaitForAttrib 3,6,"00","3c",3,10000
        oia.WaitForInputReady
        If ps.GetText(1,2,10) <> "Item entry" Then Exit Function
        If KeyOf(FieldText(ps, UPC_FIELD)) <> code Then price = ""
        ps.SendKeys "[pf3]"
        WaitReady oia
    End If
    If ps.GetText(1,2,10) <> "Item entry" Then Exit Function
    If changedVendor Then
        ps.WaitForAttrib 1,19,"00","3c",3,10000
        ps.SetCursorPos 1,45
        ps.SendKeys "[erase eof]"
        oia.WaitForInputReady
        If Trim(originalVendor) <> "" Then ps.SendKeys Trim(originalVendor)
        oia.WaitForInputReady
        ps.SendKeys "[tab]"
        oia.WaitForInputReady
    End If
    ReadRetail = price
End Function

Sub Main()
    Dim http, fso, shell, keyFile, reader, key, stamp, lines, n, code, saved
    Dim sess, ps, oia, returnedUPC, amount, cost, size, description, body
    Set shell = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    keyFile = fso.BuildPath(shell.SpecialFolders("MyDocuments"), "upc_update.key")
    If Not fso.FileExists(keyFile) Then
        MsgBox "Place your private upc_update.key in Documents first."
        Exit Sub
    End If
    Set reader = fso.OpenTextFile(keyFile, 1)
    key = ""
    If Not reader.AtEndOfStream Then key = Trim(reader.ReadLine)
    reader.Close
    If Len(key) = 0 Or Len(key) > 512 Then
        MsgBox "Invalid update key file."
        Exit Sub
    End If

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", HOME_URL & "/list", False
    http.setRequestHeader "Cache-Control", "no-cache"
    http.Send
    If http.Status <> 200 Then
        MsgBox "Cannot read UPC list. HTTP " & http.Status
        Exit Sub
    End If
    lines = Split(Replace(http.responseText, vbCr, ""), vbLf)
    If UBound(lines) < 0 Then Exit Sub
    stamp = Trim(lines(0))
    If Not IsDate(stamp) Then
        MsgBox "Invalid list timestamp. No updates sent."
        Exit Sub
    End If
    If Abs(DateDiff("s", CDate(stamp), Now)) > 300 Then
        MsgBox "List is over five minutes from the PC clock. Check Pacific time or refresh the list timestamp."
        Exit Sub
    End If
    autECLSession.SetConnectionByName(ThisSessionName)
    Set sess = autECLSession
    Set ps = sess.autECLPS
    Set oia = sess.autECLOIA
    saved = 0
    For n = 1 To UBound(lines)
        code = Trim(lines(n))
        If code <> "" Then
            If Not DigitsOnly(code) Then
                MsgBox "Invalid UPC on list line " & (n+1) & ". Stopped."
                Exit Sub
            End If
            code = KeyOf(code)
            oia.WaitForAppAvailable
            oia.WaitForInputReady
            If ps.GetText(1,2,10) <> "Item entry" Then
                MsgBox "Expected Item Entry. Stopped before UPC " & code
                Exit Sub
            End If
            ps.SetCursorPos 1,20
            ps.WaitForCursor 1,20,10000
            ps.SendKeys "[erase eof]"
            ps.SendKeys code
            If ps.GetText(1,20,Len(code)) <> code Then
                MsgBox "UPC input verification failed for " & code
                Exit Sub
            End If
            ps.SendKeys "[enter]"
            oia.WaitForAppAvailable
            oia.WaitForInputReady
            If ps.GetText(1,2,10) <> "Item entry" Then
                MsgBox "Unexpected screen after lookup. No update for " & code
                Exit Sub
            End If
            returnedUPC = FieldText(ps, UPC_FIELD)
            If Not DigitsOnly(KeyOf(returnedUPC)) Or KeyOf(returnedUPC) <> code Then
                MsgBox "Item lookup not confirmed for " & code & ". Stopped."
                Exit Sub
            End If
            cost = FieldText(ps, COST_FIELD)
            size = FieldText(ps, SIZE_FIELD)
            description = FieldText(ps, DESC_FIELD)
            If cost = "" Or description = "" Then
                MsgBox "Missing Item Entry data for " & code & ". Stopped."
                Exit Sub
            End If
            amount = ReadRetail(ps, oia, code)
            If amount = "" Then
                MsgBox "Price lookup not confirmed for " & code & ". No update sent. Check the terminal screen and vendor field before restarting."
                Exit Sub
            End If
            body = code & vbLf & amount & vbLf & cost & vbLf & size & vbLf & description
            http.Open "POST", HOME_URL & "/update-upc", False
            http.setRequestHeader "Content-Type", "text/plain; charset=utf-8"
            http.setRequestHeader "X-UPC-Update-Key", key
            http.Send body
            If http.Status <> 200 Or Trim(Replace(Replace(http.responseText,vbCr,""),vbLf,"")) <> "Saved " & code Then
                MsgBox "Update not confirmed for " & code & " (HTTP " & http.Status & "). Earlier confirmed: " & saved
                Exit Sub
            End If
            saved = saved + 1
        End If
    Next
    MsgBox "Catalog updates confirmed: " & saved
End Sub

Main