$btoken(&input,N,C,[&output])

By Imk0tter on May 06, 2021

Here is a snippit of code that allow you to get tokens from bvars (binary variables).

IE: $btoken(&bvar,0,64 64 64) returns the number of tokens separated by the string '@@@'
IE: $btoken(&bvar,n,64 64 64) returns the nth token separated by the string '@@@'

IE: $btoken(&bvar,0,@@@).text returns the number of tokens separated by the string '@@@'
IE: $btoken(&bvar,n,@@@).text returns the nth token separated by the string '@@@'

IE: $btoken(&bvar,0,@@@,&output).text returns the number of tokens separated by the string '@@@'
IE: $btoken(&bvar,n,@@@,&output).text returns the number of characters in the &output bvar that contains the nth token separated by the string '@@@'

alias btoken {
  hinc -m BTOKEN NUMBER

  var %htable BTOKEN $+ $hget(BTOKEN,NUMBER)

  hadd -m %htable COUNT 0

  var %bvar $1

  var %tokSepBvar &btokensep $+ %htable

  bset $iif($prop,-t) %tokSepBvar -1 $3

  var %tokSepLen $bvar(%tokSepBvar,0)

  var %numtok $bnumtok(%bvar, %htable, %tokSepBvar)

  $iif($2 == 0,return %numtok)

  var %range $parseRange($2, %numtok)

  var %startTok $token(%range,1,32)
  var %endTok $iif($token(%range,2,32) >= %startTok,$v1 + 1, $v1 - 1)

  if (%startTok > %numtok) return $iif(!$prop,-1)

  var %buffer &btokenbuffer $+ %htable
  var %buffer2 &btokenbuffer2 $+ %htable

  var %return

  var %outputFlag $iif($4,$true)

  var %output $iif(%outputFlag,$4)

  while %startTok != %endTok {
    var %data $hget(%htable,%startTok,%buffer)

    bcopy %buffer2 -1 %buffer 1 %data
    bcopy %buffer2 -1 %tokSepBvar 1 %tokSepLen

    $iif(%startTok > %endTok,dec,inc) %startTok 
  }

  hfree %htable

  if %outputFlag  {
    bcopy -c %output 1 %buffer2 1 $calc($bvar(%buffer2,0) - %tokSepLen)
    return $bvar(%output,0)
  }
  return $bvar(%buffer2,1,$calc($bvar(%buffer2,0) - %tokSepLen)).text
}

alias bnumtok {

  var %bvar $1
  var %htable $2

  var %btoksep $$3

  var %bnumtok &bnumtok $+ %htable

  $iif($hget(%htable,COUNT) != 0,return $hget(%htable,COUNT))

  var %findPos 1
  var %lastFindPos 1

  var %lengthOfBvar $bvar(%bvar,0)

  var %odd $bvar(%btoksep,0)

  while %lastFindPos < %lengthOfBvar {
    var %findPos $iif($bfind(%bvar,%lastFindPos,$bvar(%btoksep,1,$bvar(%btoksep,0))) == 0,$bvar(%bvar,0),$v1) - 1

    hinc -m %htable COUNT

    bcopy %bnumtok 1 %bvar %lastFindPos $calc(%findpos - %lastFindPos + $iif($calc(%findPos + %odd + 1) > %lengthOfBvar,2,1))

    hadd -mb %htable $hget(%htable,COUNT) %bnumtok 

    bunset %bnumtok

    var %lastFindPos $calc(%findPos + %odd + 1) 
  }

  return $hget(%htable,COUNT)
}

alias -l parserange {
  var %input $1
  var %maxRange $2

  var %startNumber, %endNumber,%c $token(%input,1,45)

  ;if the first character is a -, the first parameter is a negative number; proceed to second - or end of the string
  if ($left(%input,1) == -) {
    var %startNumber $calc(%maxRange - %c + 1)
    var %input $right(%input,-1)
  }
  else {
    var %startNumber %c
  }

  var %a $pos(%input,-,1)

  if %a == $len(%input) {
    ;second - as at end of string (range encountered) no second integer
    %endNumber = %maxRange
  }
  else if !%a {
    ;no - after the first token; no range
    %endNumber = %startNumber
  }
  else {
    ;range encountered; second number present
    ;proceed to first - or end of string, and if there is a positive or negative integer

    var %a $iif($Pos(%input,-,1),$v1,0)
    var %b $iif($pos(%input,-,2),$v1,0)

    var %c $token(%input,2,45)

    if %b > 0 && $calc(%b - %a) == 1 {
      ;second integer is negative,

      var %endNumber $calc(%maxRange - %c + 1)
    }
    else if %b == 0 {
      ;second integer is positive
      var %endnumber %c
    }
    else {
      ;unknown condition
      var %endnumber %c
    }
  }
  return %startNumber %endNumber
}

alias -l + {
  if (!$window(@DEBUG)) window -e @DEBUG
  echo @DEBUG $1-
}
alias -l - {
  noop $1-
}

If anyone wants to optimize the code feel free..

Comments

Sign in to comment.
Are you sure you want to unfollow this person?
Are you sure you want to delete this?
Click "Unsubscribe" to stop receiving notices pertaining to this post.
Click "Subscribe" to resume notices pertaining to this post.