rbHash

rbHash - Faking Associative Arrays in RunBASIC
Associative (string-indexed) arrays are powerful tools for text processing. This demo shows how to fake associative arrays in RunBASIC by adroit string manipulation. code format="vbnet" ' hashdemo.bas -- rbhash demonstration program ' by Jerry Muelver, HyText Consulting, http:\\hytext.com ' rev 1 October 2007 '-- ' Introducing -- The All-Powerful rbhash! ' This program demonstrates the use of a delimited string to ' function as a hash (associative array). The program subs call ' relevant rbhash subs to show useage syntax and results for the ' hash-handling routines. The rbhash subs call string-handling ' subs for string splitting, extraction, and replacement. ' ' Subroutines and functions, in order of appearance: ' - Program subs - ' main - program loop, with menu. Loop ends with choice to "Quit". ' pagehead - header for each screen ' buildhash - gets key-value pairs from user, feeds them to '    ibhashput$ ' printhash - prints rbhash istring, breaks out and displays each '    key-value pair by calling rbhashget$ ' fetchval - gets key from user, shows value for that key by '    calling rbhashget$ ' deleteval - gets key from user, calls rbhashdel$ to delete '    the key-value pair ' addval - gets key and value from user, calls rbhashput$ to '    add them to the rbhash ' modifyval - gets key to change, and value to use for the change, '    calls rbhashput$ to modify the value of that key in rbhash ' - rbhash functions - ' rbhashget$ - receives rbhash and key, returns value for the key ' rbhashput$ - receives rbhash, key, and value, then adds the '    key-value pair if the key is new, or overwrites the old value '    if the key already exists in the rbhash ' rbhashde$ - receives rbhash and key, deletes key and value '    from rbhash ' - String-handling subs - ' splitst$ - receives string and marker, returns front of string '    up to the marker, chops that portion off the front of the '    original string ' extractstr$ - receives string, openmarker, and closemarker, '    returns anything found between the two markers ' replstr$ - receives string, target, source, and {optional} '    times, replaces target with source wherever found in string; '    target and source may be of different length; if times is 0 '    does as many replacements as possible.

global ver$ global b$ b$ = " " ver$ = "v0.9"

'-- [mainloop] while choice$ <> "g" call pagehead html " a) Load sample hash, or "   html " b) Build hash to start " html " c) Fetch value by key "   html " d) Delete key/value pair " html " e) Add value to hash "   html " f) Modify value for a key " html " g) Quit "   print "Your choice ";    input choice$    choice$ = lower$(left$(choice$,1))    select case choice$        case "a"            hash$ = "{dog}beagle{cat}American short-hair{pie}apple{car}Honda Insight{language}Esperanto"            html "Hash = ";hash$;b$            input "Press ENTER to continue."; a$        case "b"            hash$ = buildhash$(hash$)        case "c"            call fetchval hash$        case "d"            hash$ = deleteval$(hash$)        case "e"            hash$ = addval$(hash$)        case "f"            hash$ = modifyval$(hash$)        case "g"            cls            print "rbHash Demo done!"            end    end select wend wait goto [mainloop]

'-- sub pagehead cls html " rbhash Demo "; ver$; " "; b$ if len(hash$) > 1 then html "Hash = "; hash$; b$ end if html b$ end sub

'-- function buildhash$(hash$) call pagehead html "Enter some favorites, first a key (dog), " html "then a value for that key (beagle). " html "To finish the list, press ENTER on blank key entry. " print hash$ = "" key$ = "a" while key$ <> "" key$ = "" input "Key: "; key$ if key$ <> "" then input "Value: "; value$ hash$ = rbhashput$(hash$, key$, value$) end if wend call printhash hash$ input "Hash built. Press ENTER to continue."; a$ buildhash$ = hash$ end function

'-- sub printhash hash$ idx = 1 html "Hash string = ";hash$;" " hash$ = mid$(hash$,2) outstr$ = word$(hash$, idx, "{") while outstr$ <> "" html left$(outstr$,instr(outstr$,"}")-1);" = " html mid$(outstr$,instr(outstr$,"}")+1);" " idx = idx + 1 outstr$ = word$(hash$,idx,"{") wend end sub

'-- sub fetchval hash$ call pagehead html "Searching: Enter a key to find matching value. " html "Press [Enter] on a blank key entry to quit. " html "Current hash: "; hash$; " " input "Find key: "; key$ while key$ <> "" html " "; rbhashget$(hash$,key$);" " key$ = "" input "Find key: "; key$ wend end sub

'-- function deleteval$(hash$) call pagehead html "Deleting: Enter a key to delete. " html "Press [Enter] on a blank key entry to quit: " html "Hash before: "; hash$;" " input " Delete key: "; key$ while key$ <> "" hash$ = rbhashdel$(hash$, key$) html "Hash now: "; hash$; " "" input "Value: "; value$ hash$ = rbhashput$(hash$, key$, value$) html "Hash now: "; hash$; " " key$ = "" input "Add key: "; key$ wend addval$ = hash$ end function

'-- function modifyval$(hash$) call pagehead html "Modifying: Enter a key to modify its value. " html "Press [Enter] on a blank key entry to quit: " html "Hash before: "; hash$; " " input " Change value for key: "; key$ while key$ <> "" input " Value: "; value$ hash$ = rbhashput$(hash$, key$, value$) html "Hash now: "; hash$; " " key$ = "" input " Change value for key: "; key$ wend modifyval$ = hash$ end function

'-- function rbhashput$(hash$, key$, value$) ' finds key$ in hash array, replaces paired value with hval$. ' adds "{" to the end of the istring to allow the last ' value in the hash to be found, removes "{" before ' returning the hash to normalize the hash string.

hk$ = "{" +key$+"}" hv$ = hk$ + value$ if instr(hash$,hk$) > 0 then hash$ = hash$ + "{" find$ = hk$ + extractstr$(hash$,hk$,"{") +"{" hv$ = hv$ + "{" hash$ = replstr$(hash$,find$,hv$,1) hash$ = left$(hash$,len(hash$)-1) else hash$ = hash$ +hv$ end if rbhashput$ = hash$ end function

'-- function rbhashget$(hash$,key$) ' finds ibkey in rbhash array, returns paired value. ' adds "{" to the end of the istring to allow the last ' value in the hash to be found. ibk$ = "{"+key$+"}" hash$ = hash$ + "{" value$ = extractstr$(hash$,ibk$,"{") rbhashget$ = value$ end function

'-- function rbhashdel$(hash$,key$) ' finds hkey$ in rbhash array, removes key and value ' adds "{" to the end of the hash string to allow the last ' value in the hash to be found, finds and deletes key ' and value, removes "{" from end of hast before ' returning modified string.

hk$ = "{" +key$ +"}" hash$ = hash$ + "{" find$ = hk$ +extractstr$(hash$,hk$,"{") +"{" hash$ = replstr$(hash$,find$,"{",1) hash$ = left$(hash$,len(hash$)-1) rbhashdel$ = hash$ end function

'-- function extractstr$(ret$,opentag$,endtag$) ' extract string between opentag and endtag ' works on copy of passed string to keep from ' modifying the original string.

openpos = 0 endpos = 0 openpos = INSTR(ret$,opentag$) IF openpos > 0 then openpos = openpos + LEN(opentag$) endpos = INSTR(ret$,endtag$,openpos) IF endpos > 0 then ret$ = MID$(ret$,openpos,endpos - openpos) END IF ELSE ret$ = "" END IF extractstr$ = ret$ end function

'-- function replstr$(ret$,hit$,src$,rept) 'find hit$ in ret$, replace with src$, do it rept times, 'do all possible if rept = 0. 'return modified string.

rpx = 0 hitpos = INSTR(ret$,hit$) while hitpos > 0 rpx = rpx + 1 front$ = LEFT$(ret$,hitpos -1 ) back$ = MID$(ret$,hitpos + LEN(hit$)) ret$ = front$ + src$ + back$ nextpos = hitpos + LEN(src$) hitpos = INSTR(ret$,hit$,nextpos) IF rpx = rept then hitpos = 0 wend replstr$ = ret$ end function code