// FtpPlistImp2.bcpl -- More property list implementation routines
// Copyright Xerox Corporation, 1981, 1982
// Last modified May 13, 1982  1:18 PM by Boggs

get "FtpProt.decl"
get "Time.d"

external
[
// outgoing procedures
GenDateProp; ScanDateProp
GenBitProp; ScanBitProp
ParseDate; WritePTV; PropError; Nin

// incoming procedures
FTPM; Zero; MoveBlock; PutTemplate; MulPlus32x16
EnumerateKeywordTable; LookupKeyword
WRITEUDT; UNPACKDT; PACKDT; FINDMONTH

// incoming statics
pListKT; CtxRunning
]

structure String [ length byte; char↑1,2 byte ]

//-----------------------------------------------------------------------------------------
let GenDateProp(prop, nil, name, pl) be
//-----------------------------------------------------------------------------------------
[
let ptv = pl + prop>>Prop.pOffset
if ptv>>Time.h ne 0 then
   PutTemplate(CtxRunning>>FtpCtx.dbls, "($S $P)", name, WritePTV, ptv)
]

//-----------------------------------------------------------------------------------------
and ScanDateProp(prop, nil, name, v) =
//-----------------------------------------------------------------------------------------
   ParseDate(v!1, (v!0)+prop>>Prop.pOffset)? true, PropError(prop, name)

//-----------------------------------------------------------------------------------------
and GenBitProp(prop, nil, name, pl) be
//-----------------------------------------------------------------------------------------
[
if pl>>PL.DPRP eq 0 return
let GenBit(prop, nil, name, i) be
   if prop>>Prop.pDPRP eq 1b15 rshift i then
      PutTemplate(CtxRunning>>FtpCtx.dbls, "(Desired-property $S)", name)
for i = 0 to 15 if (pl>>PL.DPRP & 1b15 rshift i) ne 0 then
   EnumerateKeywordTable(pListKT, GenBit, i)
]

//-----------------------------------------------------------------------------------------
and ScanBitProp(prop, nil, name, v) = valof
//-----------------------------------------------------------------------------------------
[
let kte = LookupKeyword(pListKT, v!1)
test kte ne 0
   ifso
      [
      (v!0)!(prop>>Prop.pOffset) = (v!0)!(prop>>Prop.pOffset) % kte>>Prop.pDPRP
      resultis true
      ]
   ifnot resultis PropError(prop, name)
]

//-----------------------------------------------------------------------------------------
and ParseDate(string, ptv) = valof
//-----------------------------------------------------------------------------------------
// Parses the string-format date in string into an Alto-format date in ptv.
// Returns true if successful, false if not.
//  "day-month-year hour:minute:second [zone]"
// zone:={{A|E|C|M|P|Y|H}{S|D}T}|GMT|{{+|-}hh[:mm]}
[
let utv = vec lenUTV; Zero(utv, lenUTV)
let temp, index = vec 10, 1
utv>>UTV.day = GetNumber(string, lv index)
GetToken(string, temp, lv index)
utv>>UTV.month = FINDMONTH(temp)
utv>>UTV.year = GetNumber(string, lv index) +1900
utv>>UTV.hour = GetNumber(string, lv index)
utv>>UTV.minute = GetNumber(string, lv index)
utv>>UTV.second = GetNumber(string, lv index)
while index le string>>String.length do
   [  //scan for + or -
   let char = string>>String.char↑index
   if AlphaNumeric(char) break
   index = index +1
   if char eq $- % char eq $+ then
      utv>>UTV.zone.sign = char eq $-
   ]
GetToken(string, temp, lv index)
let zone = temp>>String.length ne 0
if zone then
   [
   let char = temp>>String.char↑1
   test char ge $0 & char le $9
      ifso
         [
         Nin(temp, lv utv>>UTV.zone.hour)
         utv>>UTV.zone.minute = GetNumber(string, lv index)
         ]
      ifnot
         [
         utv>>UTV.zone.hour = selecton char & 137b into
            [
            case $A: 4  // Atlantic
            case $E: 5  // Eastern
            case $C: 6  // Central
            case $M: 7  // Mountain
            case $P: 8  // Pacific
            case $Y: 9  // Youkon
            case $H: 10  // Hawaiian
            default: 0  // also GMT
            ]
         char = temp>>String.char↑2
         utv>>UTV.daylight = char eq $D % char eq $d
         ]
   ]
resultis PACKDT(utv, ptv, zone) eq 0
]

//-----------------------------------------------------------------------------------------
and GetToken(string, lvDest, lvIndex) be
//-----------------------------------------------------------------------------------------
[
while @lvIndex le string>>String.length do  // strip leading punctuation
   [
   if AlphaNumeric(string>>String.char↑(@lvIndex)) break
   @lvIndex = @lvIndex +1
   ]
let length = 0  // accumulate token
while @lvIndex le string>>String.length & length ls 19 do
   [
   lvDest>>String.char↑(length+1) = string>>String.char↑(@lvIndex)
   length = length +1
   @lvIndex = @lvIndex +1
   unless AlphaNumeric(string>>String.char↑(@lvIndex)) break
   ]
lvDest>>String.length = length
]

//-----------------------------------------------------------------------------------------
and AlphaNumeric(char) = (char ge $0 & char le $9) %
   (char ge $A & char le $Z) % (char ge $a & char le $z)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and GetNumber(string, lvIndex) = valof
//-----------------------------------------------------------------------------------------
[
let temp = vec 10
GetToken(string, temp, lvIndex)
let number = 0
Nin(temp, lv number)
resultis number
]

//-----------------------------------------------------------------------------------------
and WritePTV(stream, ptv) be
//-----------------------------------------------------------------------------------------
[
let utv = vec lenUTV
if ptv!0 ne 0 then
   [
   UNPACKDT(ptv, utv)
   WRITEUDT(stream, utv, true)
   ]
]

//-----------------------------------------------------------------------------------------
and PropError(prop, name) = valof
//-----------------------------------------------------------------------------------------
[
FTPM(markNo, prop>>Prop.pErrSubCode, "Malformed $S", false, name)
resultis false
]

//-----------------------------------------------------------------------------------------
and Nin(string, lvDest, double; numargs na) = valof
//-----------------------------------------------------------------------------------------
[
if na ls 3 then double = false
let start = 1
for i = 1 to string>>String.length do
   if string>>String.char↑i ne $*S then
      [ start = i; break ]
let number = vec 1; Zero(number, 2)
for i = start to string>>String.length do
   [
   let char = string>>String.char↑i
   if char ls $0 % char gr $9 then resultis false
   MulPlus32x16(char-$0, 10, number)
   ]
test double
   ifnot lvDest!0 = number!1
   ifso MoveBlock(lvDest, number, 2)
resultis true
]