home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 35 Internet
/
35-Internet.zip
/
srev13h.zip
/
VARSTORE.RXX
< prev
next >
Wrap
Text File
|
1999-02-27
|
32KB
|
1,140 lines
/* The "variable storage" thread
Currently (nov 1997) used for:
1) Check clientname cache for an entry
2) Add clientname/ipaddress to clientname cache
3) Check the hit_cache for a matching entry
4) Store entry in the "hit cache"
5) Variable storage (using SREF_VALUE
6) SRE-http queue support (using SREF_QUEUE
7) Request specific variables storage
Future uses may occur.
*/
/****************** User Changeable Variables */
/* Length of time a "clientname" entry stays in the cache.
Longer values speed up throughput, but risk errors when ip-name (DNS)
matches change. Value is in fractions of a day (0.05 is about 1 hour) */
clientname_duration=0.05
/* Maximum number of entries in clientname cache */
clientname_max=800
/* Maximum number of requests to store information about (for retrieval by
SREF_VALUE(,,'REQ',a_request_number)
This MUST be at least as great as the GoServe "maximum simultaneous clients"
variable
Larger values are needed if postfiltering wants to access request specific
variables. */
reqvars.!max=150
/************* END of user changable parameters */
parse upper arg usequeue , USESEM , max_semwait,sport,limcli
mytid=dostid()
foo=pmprintf_sref(' SRE-http Varstore: thread and queue='||mytid', 'usequeue)
hit_cache.0=0 ; hit_cache.!freelist=' '
client_cache.0=0 ; client_cache.!freelist=' '
last_cleanup=0
queue.0=' '
numeric digits 11
reqvars.0=' '
reqvars.!OTHER.0=' '
foo=limcli /*foo=extract('limitclients')*/
if foo>reqvars.!max then do
call pmprintf(' SRE-http Varstore: Warning! REQVARS.!MAX too low, resetting to 'foo)
reqvars.!max=foo+5
end
resetit:
if usequeue="" | USESEM="" then do
call pmprintf('SRE-http Varstore ERROR: initialization ERROR: '||usequeue)
exit
end
/* Initialization now done == start waiting for requests for variables. */
/* request body is in the ISIT variable below. It will consist of
TYPE , data
where type can be:
GET_CLIENT, PUT_CLIENT, GET_HIT, PUT_HIT, GET_VAR, PUT_VAR, PUT_VAR2, QUEUE,
REQ_GET, REQ_PUT, REQ_INI
*/
signal on error name iserror
signal on syntax name iserror
bakme:
a=rxqueue('s',usequeue)
aq=queued()
if aq=0 then do
foo=cleanup_stuff() /* nothing happening; clean up stuff? */
WOW=EVENTSEM_WAIT(USESEM,max_semwait)
aq=-1
if wow=640 then do
signal bakme
end
IF WOW<>0 THEN do /* FATAL ERROR */
call pmprintf(' Fatal semaphore error in VARSTORE thread ')
EXIT
end
end
wow=EVENTSEM_RESET(usesem)
if aq=-1 then do
if queued()=0 then signal bakme
end
parse pull isit0
goobs:
if isit0=" " then signal bakme
parse var isit0 idnum ',' newq ',' newsem ',' ISIT
IDNUM=TRANSLATE(IDNUM,' ','00090A0D'X)
parse var idnum idnum host_nickname
if newq="" | newsem="" then do
call pmprintf(' SRE-http Varstore ERROR: missing queue or semaphore ')
signal bakme
end
newq=strip(newq); newsem=strip(newsem)
if abbrev(strip(translate(isit)),'*DIE*')=1 then exit
if abbrev(strip(translate(isit)),'*RESET*')=1 then do
drop client_cache. ; drop hit_cache. ; drop vars.
client_cache.0=0 ; hit_cache.0=0 ; hit_cache.!freelist=' '
client_cache.!freelist=' '
foo=pmprintf_sref('SRE-http Varstore: Resetting ',,sport)
signal bakme
end
/* do something ... */
parse var isit type ',' stuff ; type=upper(strip(type))
select
when type="GET_CLIENT" then do
dog1=get_client(stuff) ; isend=1
end
when type='PUT_CLIENT' then do
dog1=put_client(stuff) ; isend=0
end
when type="PUT_HIT" then do
dog1=put_hit(stuff) ; isend=0
end
when type="GET_HIT" then do
dog1=get_hit(stuff)
isend=1
end
when type="PUT_VAR" then do
dog1=put_var(stuff) ; isend=0
end
when type="PUT_VAR2" then do
dog1=put_var(stuff) ; isend=1
end
when type="GET_VAR" then do
dog1=get_var(stuff) ; isend=1
end
when type='QUEUE' then do
dog1=do_queue(stuff)
isend=1-quick_mode
end
when abbrev(type,'REQ')=1 then do
dog1=do_req_vars(type,stuff)
isend=1-quick_mode
end
otherwise do
call pmprintf(" SRE-http Varstore ERROR: bad request to Varstore Thread: "type)
isend=1
dog1='Error '
end
end
/* return result? */
if isend=1 then do
a=rxqueue('s',newq)
dog1=idnum','dog1
push dog1
wow=eventsem_post(newsem)
end
signal bakme /* do it again */
iserror:
signal off error ; signal off syntax
call pmprintf('SRE-http Varstore ERROR: in Varstore thread 'sigl)
a=rxqueue('d',usequeue)
a=rxqueue('c',usequeue)
a=eventsem_close(usesem)
a=eventsem_create(usesem)
a=rxqueue('s',newq)
push idnum ', 0 '
wow=eventsem_post(newsem)
call pmprintf('SRE-http Varstore: done resetting Varstore thread ')
signal on error name iserror
signal on syntax name iserror
signal bakme
exit
/**********************************/
/* store a variable, return old value */
put_var:procedure expose vars.
parse arg stuff
parse var stuff aname','avalue
aname='!'||strip(upper(aname))
if vars.aname<>upper('VARS.'aname) then
oldval=vars.aname
else
oldval=''
vars.aname=avalue
return oldval
/**********************************/
/* retireive a variable */
get_var:procedure expose vars.
parse arg stuff
parse var stuff aname','avalue
if aname='*' then do /* return list of currently stored variables */
aa=cvtails(vars,vtails)
oog=""
do ii=1 to vtails.0
oog=oog||' '||substr(vtails.ii,2)
end
return oog
end
/* get the aname variable */
aname='!'||strip(upper(aname))
if vars.aname<>upper('VARS.'||aname) then
return vars.aname
else
return ' '
/**********************************/
/* look in cache for a clientname that matches the IP address. If none found, then
return 0 */
get_client:procedure expose client_cache. hit_cache.
parse arg stuff
amin=time('M')
aday=date('b')
nowtime=aday+(amin/(24*60))
/* stuff should contain an IP number */
do mm=1 to client_cache.0
if client_cache.mm=stuff then do
if client_cache.mm.!expire>nowtime then do
return client_cache.mm.!address
end
client_cache.mm=' ' /* this has expired -- mark for deletion */
client_cache.!freelist=client_cache.!freelist||' '||mm
return 0 /* and stop looking */
end
end
return 0
/**********************************/
/* add clientname to cache */
put_client:procedure expose client_cache. clientname_duration clientname_max last_cleanup
parse arg stuff
amin=time('M')
aday=date('b')
nowtime=aday+(amin/(24*60))
parse var stuff ipnum ipname aduration amax
if aduration=' ' | datatype(aduration)<>"NUM" then aduration=clientname_duration
if amax=' ' | datatype(amax)<>'NUM' then amax=clientname_max
if client_cache.!freelist<>' ' then do
parse var client_cache.!freelist ido client_cache.!freelist
ido=strip(ido)
end
else do
ido=client_cache.0+1
if ido>amax then do
foo=cleanup_stuff(2) /* remove 1/2 entries & old stuff */
ido=client_cache.0+1
end
client_cache.0=ido
end
client_cache.ido=strip(ipnum)
client_cache.ido.!address=strip(ipname)
client_cache.ido.!expire=nowtime+aduration
return ' '
/**************************/
/* cleanup client_cache and hit_cache
Do it every 0.01 days (about every 10 minutes) */
cleanup_stuff:procedure expose last_cleanup client_cache. hit_cache.
parse arg drophalf /* blank= cleanup both, 1=drophalf cleanup hit, 2=drophalf cleanup client */
amin=time('M')
aday=date('b')
nowtime=aday+(amin/(24*60))
if drophalf=' ' then do
if nowtime<(last_cleanup+0.0001) then return 0 /* not time to do it yet */
last_cleanup=nowtime
end
ido=0
jm=client_cache.0; if drophalf=1 then jm=0 /* a skip hack */
do mm=1 to jm
if client_cache.mm.!expire<nowtime then iterate /* drop this one */
if drophalf=2 & mm<(1+client_cache.0/2) then iterate /* overflow, get rid of old ones */
ido=ido+1
tmp.ido=client_cache.mm ; tmp.ido.!expire=client_cache.mm.!expire
tmp.ido.!address=client_cache.mm.!address
end
client_cache.0=ido ; client_cache.!freelist=' '
do mm=1 to ido
client_cache.mm=tmp.mm ; client_cache.mm.!expire=tmp.mm.!expire
client_cache.mm.!address=tmp.mm.!address
end
if drophalf=2 then return 0
ido=0
do mm=1 to hit_cache.0
if hit_cache.mm.!expire<nowtime then iterate /* drop this one */
if drophalf=1 & mm<(hit_cache.0/2) then iterate /* overflow, get rid of old ones */
ido=ido+1 /* add to temporary list */
tmp.ido.!atype=hit_cache.ido.!atype
tmp.ido.!aurl= hit_cache.ido.!aurl
tmp.ido.!aip=hit_cache.ido.!aip
tmp.ido.!expire=hit_cache.ido.!expire
tmp.ido.!stuff=hit_cache.ido.!stuff
end
hit_cache.0=ido ; hit_cache.!freelist=' '
do mm=1 to ido
hit_cache.ido.!atype=tmp.ido.!atype
hit_cache.ido.!aurl=tmp.ido.!aurl
hit_cache.ido.!aip =tmp.ido.!aip
hit_cache.ido.!expire=tmp.ido.!expire
hit_cache.ido.!stuff=tmp.ido.!stuff
end
return 0
/**********************************/
/* add hit to cache */
put_hit:procedure expose hit_cache. last_cleanup
parse arg stuff
/* moo=lenc||' '||thetype||' '||theurl0||' '||who||' '||endtime||' '||stuff */
amin=time('M')
aday=date('b')
nowtime=aday+(amin/(24*60))
/* note that aduration and amax MUST be sent with other info! */
parse var stuff amax anent
if datatype(aduration)<>"NUM" then aduration=0.01
if datatype(amax)<>"NUM" then amax=500
if amax<50 & amax>0 then amax=100 /* in case of old style "5 = 5000 bytes " */
if hit_cache.!freelist<>' ' then do
parse var hit_cache.!freelist ido hit_cache.!freelist
ido=strip(ido)
end
else do
ido=hit_cache.0+1
if ido>amax then do /* drop first 1/2 of the entries */
foo=cleanup_stuff(1)
ido=hit_cache.0+1
end
hit_cache.0=ido
end
parse var anent atype aurl aip aexpire stuff
hit_cache.ido.!atype=upper(strip(atype))
hit_cache.ido.!aurl=upper(strip(aurl))
hit_cache.ido.!aip =strip(aip)
hit_cache.ido.!expire=strip(aexpire)
hit_cache.ido.!stuff=strip(stuff)
return ' '
/**********************************/
/* look for matching entry in hit_cache */
get_hit:procedure expose hit_cache.
parse arg stuff
parse upper var stuff thetype who theurl
thetype=strip(thetype)
who=strip(who) ; theurl=strip(theurl)
amin=time('M') ; aday=date('b')
nowtime=aday+(amin/(24*60))
/* stuff should contain an info that was saved (such as a hit count) */
do mm=1 to hit_cache.0
if hit_cache.mm.!atype=' ' then iterate /* emtpy means deleted entry */
if theurl<>hit_cache.mm.!aurl | hit_cache.mm.!aip<>who | hit_cache.mm.!atype<>thetype then iterate
if hit_cache.mm.!expire >= nowtime then return hit_cache.mm.!stuff
/* else expired.. */
hit_cache.mm.!atype=' '
hit_cache.!freelist=hit_cache.!freelist||' 'mm
return ' ' /* don't check for duplicate entries */
end
return ' ' /* blank means "not found in hit cache" */
/**********************************/
/* called via
retvalue=SREF_QUEUE(QueueName,action,value,port)
Note: queue.0 will contain a list of all currently active queue.
This is designed to work with SREF_QUEUE.
*/
do_queue:procedure expose queue. quick_mode
parse arg stuff
parse var stuff queuename','action','mod1','mod2','aval
quick_mode=0 /* may be temporarily set to one by a PUSH call */
queuename=upper(strip(queuename))
action=upper(strip(action))
mod1=upper(strip(mod1))
mod2=upper(strip(mod2))
if wordpos(action,'POP READ PUSH QUEUE STRIP INIT KILL LOCKON LOCKOFF FIND INFO')=0 then do
call pmprintf_sref('SREF_QUEUE Storage: bad action: 'action)
return ""
end
a1=date('b') ; a2=time('s')/(24*60*60)
nowtime=a1+a2
crlf='0d0a'x
aqn='!'||queuename
/* init? */
if action='INIT' then do
if symbol('QUEUE.!'||queuename)='VAR' then return -5 /* queue exists */
if aval="" then aval=0
if queuename="" then do
call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
return -10
end
if aval="" then aval='0d0a'x
queue.aqn=nowtime
queue.aqn.!max=mod1
queue.aqn.!lifespan=mod2
queue.aqn.!dlm=aval
queue.aqn.!bot=1000
queue.aqn.!top=999
queue.0=queue.0' 'queuename
queue.aqn.!lock=0 /*unlocked*/
queue.aqn.!key=1 /* generic key */
return 1
end
/* kill? */
if action='KILL' then do
if symbol('QUEUE.!'||queuename)<>'VAR' then return -1 /* queue does not exist */
if queuename="" then do
call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
return -10
end
ido=1+queue.aqn.!top-queue.aqn.!bot
do mm=queue.aqn.!bot to queue.aqn.!top
fii=drop_a_rec(aqn,mm)
end
drop queue.aqn queue.aqn.!max queue.aqn.!bot queue.aqn.!top ,
queue.aqn.!lock
ii=wordpos(queuename,queue.0)
if ii>0 then queue.0=delword(queue.0,ii,1)
return ido
end
/* info */
if action='INFO' then do
if symbol('QUEUE.!'||queuename)<>'VAR' & queuename<>'*' then return -1 /* queue does not exists */
if queuename="" then do
call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
return -10
end
aval=strip(aval)
taval=upper(aval)
select
when (queuename='*') & abbrev(taval,'#QUE')=1 then return words(queue.0)
when (queuename='*') & abbrev(taval,'NAMES')=1 then return queue.0
when (queuename='*') & abbrev(taval,'SIZ')=1 then do
tott=0
do ll=1 to words(queue.0)
aw=strip(word(queue.0,ll))
aq='!'||aw
do lll=queue.aq.!bot to queue.aq.!top
tott=tott+queue.aq.lll.!bytes
end
end
return tott
end
when abbrev(taval,'REC')=1 then do
isiz=1+queue.aqn.!top-queue.aqn.!bot
return isiz
end
when abbrev(taval,'CREAT')=1 then return queue.aqn
when abbrev(taval,'MAX')=1 then return queue.aqn.!max
when abbrev(taval,'LOCK')=1 then do
if queue.aqn.!lock>nowtime then return queue.aqn.!key
return 0
end
when abbrev(taval,'SIZ')=1 then do
tott=0
do mm=queue.aqn.!bot to queue.aqn.!top
tott=tott+queue.aqn.mm.!bytes
end
return tott
end
otherwise do
return -4
end
end
end
if action='LOCKON' then do
if aqn='!' then return -10
if symbol('QUEUE.!'||queuename)<>'VAR' then return -1 /* queue does not exists */
if nowtime<queue.aqn.!lock then return -14 /* already locked */
queue.aqn.!lock=nowtime+aval
queue.aqn.!key=upper(strip(mod1))
return 1
end
if action="LOCKOFF" then do
if aqn='!' then return -10
if symbol('QUEUE.!'||queuename)<>'VAR' then return -1 /* queue does not exists */
if queue.aqn.!key<>1 upper(strip(mod1))<>1 & queue.aqn.!key<>upper(strip(mod1)) then return -15 /* key mismatch */
queue.aqn.!lock=0
return 1
end
/* POP and READ */
if action='POP' | action='READ' then do
yow=queue_pop(aqn,action,mod1,mod2,aval)
return yow
end
/* FIND */
if action="FIND" then do
yow=queue_find(aqn,mod1,mod2,aval)
end
/* PUSH */
if action='PUSH' then do
yow=queue_push(aqn,mod1,mod2,aval)
end
return yow
/**********************************************/
/* PUSH
type=TOP BOTTOM REC=
options=QUICK REMOVE ID= (any combo)
aval=value to write
*/
queue_push:procedure expose queue. quick_mode nowtime
parse arg aqn,type,options,aval
recoffset=""
if aqn='!' then do
return -10
end
if symbol('QUEUE.'||aqn)<>'VAR' then do /* initialize an unlimited length queue */
queue.aqn.!max=0
queue.aqn=nowtime
queue.aqn.!dlm='0d0a'x
queue.aqn.!top=999
queue.aqn.!bot=1000
queue.aqn.!lock=0
queue.aqn.!key=1 /* generic key */
fq=strip(aqn,'l','!')
queue.0=queue.0' 'fq
end
remove_full=0 ; quick_mode=0 ; id=""
/* First, remove lifespan-expired records */
if queue.aqn.!lifespan>0 then do /* 0 means infinite */
ikill=0
do ll=queue.aqn.!bot to queue.aqn.!top
if nowtime-queue.aqn.ll.!time < queue.aqn.!lifespan then leave
ikill=ll
end
if ikill>0 then do /* got some old duffers */
do ll=queue.aqn.!bot to ikill
foo=drop_a_rec(aqn,ll)
end
queue.aqn.!bot=ikill+1
end
end
/* dig stuff out of options */
do until options=""
parse upper var options ax options ; ax=strip(ax)
if abbrev(ax,'REM')=1 then remove_full=1
if abbrev(ax,'QUI')=1 then quick_mode=1
if abbrev(ax,'ID')=1 then do
parse upper var ax . '=' id
end
end
/* check for filled up */
currecs=1+queue.aqn.!top-queue.aqn.!bot
if currecs>queue.aqn.!max & queue.aqn.!max<>0 then do
if remove_full=0 then return -8
end
else do
remove_full=0 /* not full, so no removal needed */
end
if abbrev(type,'REC')=1 then do /* overwrite a record */
parse var type . '=' recoffset ;
recoffset=strip(recoffset)
if recoffset="" | datatype(recoffset)<>'NUM' then return -2
type='REC'
remove_full=0 /*overwrite, so no overflow worries */
end
else do /* locked against PUSH and QUEUE ? */
if nowtime<queue.aqn.!lock then return -20
end
select /* add to top or bottom */
when type='BOTTOM' then do
ii=queue.aqn.!bot-1
queue.aqn.ii.!value=aval
queue.aqn.ii.!bytes=length(aval)
queue.aqn.ii.!time=nowtime
queue.aqn.ii.!id=id
queue.aqn.!bot=ii
if remove_full=1 then do /* remove top */
eek=queue.aqn.!top
fii=drop_a_rec(aqn,eek)
queue.aqn.!top=eek-1
end
end
when type='TOP' then do
ii=queue.aqn.!top+1
queue.aqn.ii.!value=aval
queue.aqn.ii.!bytes=length(aval)
queue.aqn.ii.!time=nowtime
queue.aqn.ii.!id=id
queue.aqn.!top=ii
if remove_full=1 then do /* remove bottom */
eek=queue.aqn.!bot
fii=drop_a_rec(aqn,eek)
queue.aqn.!bot=eek+1
end
end
when abbrev(type,'REC')=1 then do
if recoffset>0 then
ii=queue.aqn.!bot+aval-1
else
ii=1+queue.aqn.!top-aval
if ii>queue.aqn.!top | ii<queue.aqn.!bot then return -2
queue.aqn.ii.!value=aval
queue.aqn.ii.!bytes=length(aval)
queue.aqn.ii.!id=id
queue.aqn.ii.!time=nowtime
end
otherwise nop
end
/* check if bottom to close to 0 */
if queue.aqn.!bot=1 then do /* to close; move it up */
igoo=0
do ll=queue.aqn.!top to 1 by -1
igoo=1000+ll
queue.aqn.igoo.!value=queue.aqn.ll.!value
queue.aqn.igoo.!bytes=queue.aqn.ll.!bytes
queue.aqn.igoo.!time=queue.aqn.ll.!time
queue.aqn.igoo.!id=queue.aqn.ll.!id
if ll<1000 then foo=drop_a_rec(aqn,ll) /* delete this record */
end
queue.aqn.!top=queue.aqn.!top+999
queue.aqn.!bot=1000
end
return 1
/**********************************************/
/* do FIND id
type= TOP or BOTTOM (or top= or bottom=)
infofield=value time size id rec, exact partial wild, id=no id=yes
aval=the id look for
*/
queue_find:procedure expose queue. nowtime
parse upper arg aqn,type0,inf0,aval
parse var inf0 infofield srchtype fieldtype
infofield=strip(infofield); srchtype=strip(srchtype); fieldtype=strip(fieldtype)
parse var type0 type '=' ioffset
type=strip(type)
if ioffset="" | datatype(ioffset)<>'NUM' then ioffset=1
ioffset=max(ioffset,1)
if aqn='!' then do
if infofield="" | infofield='VALUE' then return ""
return -10
end
if symbol('QUEUE.'||aqn)<>'VAR' then do
if infofield="" | infofield='VALUE' then return ""
return -1
end
if aval="" then do
if infofield="" | infofield='VALUE' then return ""
return -11 /* bad aval */
end
nrecs=1+queue.aqn.!top-queue.aqn.!bot
/* check for empty queue */
if nrecs<1 then do
if infofield="" | infofield='VALUE' then return ""
return -3
end
if nrecs<ioffset then do
if infofield="" | infofield='VALUE' then return ""
return -16
end
/* what info to get */
select /* the info to return */
when infofield='VALUE' then want='!VALUE'
when infofield='TIME' then want='!TIME'
when infofield='ID' then want='!ID'
when infofield='SIZE' then want='!BYTES'
otherwise want='!VALUE'
end
igot=0
if fieldtype='ID=YES' then aval=upper(strip(aval))
do jj0=ioffset to nrecs
jj=jj0
if type='TOP' then jj=1+nrecs-jj
jj=queue.aqn.!bot+jj-1 /* includes 1000 offset */
vfield=queue.aqn.jj.!id
if fieldtype='ID=NO' then vfield=queue.aqn.jj.!value /* what to search */
select /* 3 different types of search */
when srchtype='EXACT' then do
if vfield==aval then igot=jj
end
when srchtype='PARTIAL' then do
if pos(aval,upper(vfield))>0 then igot=jj
end
when srchtype='WILD' then do
if wild_match(vfield,aval)<>'0' then igot=jj
end
otherwise do
if queue.aqn.jj.!id==aval then igot=jj
end
end /*select */
if igot=0 then iterate
/* got match, return info */
if abbrev(infofield,'REC')=1 then do
daval=jj0
end
else do
daval=queue.aqn.jj.want
end
return daval
end
/* not found */
if infofield="" | infofield='VALUE' then return ""
return -12
/**********************************************/
/* do POP and READ
Action is READ or POP
type is TOP, BOTTOM, NEWEST, OLDEST, REC
infofield is VALUE, ID, TIME, SIZE, #RECORDS NOREAD
aval is count, or timespan (or nothing).
*/
queue_pop:procedure expose queue. nowtime quick_mode
parse arg aqn,action,type,infofield,aval
buildit=""
if aqn='!' then do
if infofield="" | infofield='VALUE' then return ""
call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
return -10
end
if symbol('QUEUE.'||aqn)<>'VAR' then do
if infofield="" | infofield='VALUE' then return ""
return -1
end
/* check for empty queue */
if queue.aqn.!top<queue.aqn.!bot then do
if infofield="" | infofield='VALUE' then return ""
return -3
end
if datatype(aval)<>'NUM' & aval<>"" then do
if infofield="" | infofield='VALUE' then return ""
return -8 /* bad aval */
end
if action='POP' then do
if nowtime<queue.aqn.!lock then return -20
end
dlm=queue.aqn.!dlm
/* what info to get */
select /* the info to return */
when infofield='VALUE' then want='!VALUE'
when infofield='TIME' then want='!TIME'
when infofield='ID' then want='!ID'
when infofield='SIZE' then want='!BYTES'
when infofield='NOREAD' then quick_Mode=1
otherwise want='!VALUE'
end
/* convert NEWEST and OLDEST into TOP and BOTTOM,
aval has been converted into fractional days */
if type="NEWEST" then do
chktime=nowTIME-aval /* any !time after chktime is okay */
igot=0
do mm=queue.aqn.!top to queue.aqn.!bot by -1
if queue.aqn.mm.!time<chktime then leave
igot=IGOT+1
end
aval=igot
type='TOP'
end
if type='OLDEST' then do
chktime=queue.aqn+aval /*anytime before chktime */
igot=0
do mm= queue.aqn.!bot to queue.aqn.!top
if queue.aqn.mm.!time>chktime then leave
igot=igot + 1
end
type='BOTTOM'
aval=igot
end
/* make sure aval isn't too big */
aval=min(aval,1+queue.aqn.!top-queue.aqn.!bot)
if aval=0 then do /* nothing within timespan */
if infofield="" | infofield='VALUE' then return ""
return -9
end
/* pop or read something */
select
when type='TOP' then do /* from top of queue */
if infofield="#RECORDS" then do /* how many records would be returned */
icur=1+queue.aqn.!top-queue.aqn.!bot
return min(icur,aval)
end
ifoo=queue.aqn.!top
if quick_mode=0 then buildit=queue.aqn.ifoo.want /* info from first record to return */
if action='POP' then fii=drop_a_rec(aqn,ifoo)
do ij=1 to aval-1 /* perhaps add more */
ifoo=queue.aqn.!top-ij
if quick_mode=0 then buildit=buildit||dlm||queue.aqn.ifoo.want
if ifoo=queue.aqn.!bot then leave
if action="POP" then
fii=drop_a_rec(aqn,ifoo)
end
if action="POP" then do /* if pop, reset limits */
newtop=max(queue.aqn.!bot-1,queue.aqn.!top-aval)
queue.aqn.!top=newtop
end
return buildit
end /* when TOP */
when type='BOTTOM' then do /* from bottom of queue */
if infofield='#RECORDS' then do /* how many records would be returned */
icur=1+queue.aqn.!top-queue.aqn.!bot
return min(icur,aval)
end
ifoo=queue.aqn.!BOT
if quick_mode=0 then buildit=queue.aqn.ifoo.want /* first record to return */
if action='POP' then fii=drop_a_rec(aqn,ifoo)
do ij=1 to aval-1 /* perhaps add more */
ifoo=queue.aqn.!bot+ij
if quick_mode=0 then buildit=buildit||dlm||queue.aqn.ifoo.want
if ifoo=queue.aqn.!top then leave
if action="POP" then fii=drop_a_rec(aqn,ifoo)
end
if action="POP" then do /* if pop, reset limits */
newbot=min(queue.aqn.!top+1,queue.aqn.!bot+aval)
queue.aqn.!bot=newbot
end
return buildit
end /* when DEFAULT OR TOP */
when type='REC' then do /* explicit record */
if aval<0 then
ido=1+queue.aqn.!top-aval
else
ido=queue.aqn.!bot+aval-1
if ido>queue.aqn.!top | ido<queue.aqn.!bot then do
if infofield="" | infofield="VALUE" then return ''
return -2
end
return queue.aqn.ido.want
end
otherwise do
if ido>queue.aqn.!top then do
if infofield="" | infofield='VALUE' then return ""
return -100
end
end
end /* select */
/*****************/
/* drop a record */
drop_a_rec:procedure expose queue.
parse arg aqn,mm
drop queue.aqn.mm.!value queue.aqn.mm.!time queue.aqn.mm.!bytes queue.aqn.mm.!id
return 1
/************************/
/* Do a multi wild card match -- return stats on match
Stats are list of letter positions (in needle) that are matched
Or, -1 for "exact match"
OR, 0 for "no match"
Example: Needle="THIS/IS/VERY/SILLY"
haystack="THIS*VERY*"
would yield: 1 2 3 4 9 10 11 12
One can then compare this result list to other result lists (to ascertain
best match */
wild_match:procedure
parse upper arg needle, haystack ; haystack=strip(haystack)
if needle=haystack then return -1 /* -1 signals exact match */
ast1=pos('*',haystack)
if ast1=0 then return 0 /* 0 means no match */
if haystack='*' then do
if length(needle)=0 then
return 100000
else
return length(needle)
end
ff=haystack
ii=0
do until ff=""
ii=ii+1
parse var ff hw.ii '*' ff
hw.ii=strip(hw.ii)
end
if hw.ii='' then ii=ii-1
hw.0=ii
/* check each component of haystackw against needle -- all components
must be there */
resu=' '
istart=1 ; ido=2
if ast1>1 then do /* first check abbrev */
if abbrev(needle,hw.1)=0 then return 0
aresu=length(hw.1)
if hw.0=1 then do
do nm=1 to aresu
resu=resu||' '||nm
end /* do */
return resu /* if haystacy of form abc*, we have a match */
end
ido=2 ; istart=aresu+1
do mm=1 to aresu
resu=resu||' '||mm
end /* do */
end
/* if here, then first part (a non wildcard) of haystack matches first
part of needle
Now check sequentially that each remaining part also exists
*/
do mm=ido to hw.0
igoo=pos(hw.mm,needle,istart)
if igoo=0 then return 0
tres=length(hw.mm)
istart=igoo+tres
do nn=igoo to (istart-1)
resu=resu||' '||nn
end /* do */
end
if istart >= length(needle) | right(haystack,1)='*' then
return resu
return 0
/**********************************/
/* request specific variables
syntax of stuff is
request_thread,info
where info depends on type:
REQ_GET : The variable name (returns '' if no such request variable)
REQ_PUT : varname','value
REQ_INI : host_Nickname,servername
special REQ_GET varnames:
* -- all varnames for this request
!MAX -- value of reqvars.!max
!ACTIVE -- value of reqvars.0
*/
do_req_vars:procedure expose reqvars. quick_mode
parse arg type,stuff
/* get the thread id that identifies the request space */
parse var stuff tid','stuff
/* catch non specific tid */
if datatype(tid)<>'NUM' then do /* non specfic request (daemons, postfilter */
tid='!OTHER'
end
/* need thread id */
quick_mode=1
select
when type='REQ_GET' then do
quick_Mode=0
ipp=wordpos(tid,reqvars.0)
if ipp=0 then return '.' /* no info on this request */
toget=strip(upper(stuff))
if toget='*' then return reqvars.tid.0 /* return variable list */
if toget='!ACTIVE' then return reqvars.0 /* requests for which info is avaialable */
if toget='!MAX' then return reqvars.!max /* max # requests to store info on */
if wordpos(toget,reqvars.tid.0)=0 then return '' /* no such var for this request */
aa='!'||toget
return reqvars.tid.aa
end
when type='REQ_PUT' then do
quick_mode=1
ipp=wordpos(tid,reqvars.0)
if ipp=0 then return ''
parse var stuff vname','stuff
if words(vname)=1 then do
vname=strip(upper(vname))
aa='!'VNAME
reqvars.tid.aa=stuff
if wordpos(vname,reqvars.tid.0)=0 then reqvars.tid.0=reqvars.tid.0' 'vname
end
else do
do forever
if vname="" then leave
parse var vname vname0 vname
parse var stuff stuff0','stuff
vname0=strip(upper(vname0))
aa='!'VNAME0
reqvars.tid.aa=stuff0
if wordpos(vname0,reqvars.tid.0)=0 then reqvars.tid.0=reqvars.tid.0' 'vname0
end
end
end
when type='REQ_INI' then do
dmax=reqvars.!max ; dloop=0
if words(reqvars.0)>=reqvars.!max then do
dloop=(words(reqvars.0)-reqvars.!max)+3
end
do jj=1 to dloop /* prune old request info */
nid=strip(word(reqvars.0,1))
do ii=1 to words(reqvars.nid.0) /* drop vars associated with this request */
aw='!'||strip(word(reqvars.nid.0,ii))
drop reqvars.nid.aw
end
drop reqvars.nid.0
parse var reqvars.0 foo reqvars.0
end
/* == DEBUG stuff.
foo=cvtails(reqvars,aa)
call pmprintf(" # items in reqvars= "aa.0)
aff='g:\goserve\a.out'
call lineout aff,' '
call lineout aff,reqvars.0
call lineout aff,'# items in reqvars= 'aa.0
do jj=1 to aa.0
call lineout aff,aa.jj
end
call lineout aff
******/
reqvars.0=reqvars.0' 'tid /* add this request id; always have OTHER */
if pos('!OTHER',reqvars.0)=0 then reqvars.0='!OTHER 'reqvars.0
reqvars.tid.0=''
do until stuff=''
parse var stuff a1 stuff
parse var a1 a1a'='a1b ; a1a=strip(upper(a1a))
reqvars.tid.0=reqvars.tid.0' 'a1a
foo='!'a1a
reqvars.tid.foo=a1b
end
quick_mode=1
end
otherwise nop
end
return 0