home *** CD-ROM | disk | FTP | other *** search
- /*
- $VER: CacheControl.awebrx 1.4 (30.9.99)
- Additional Cache Controls for AWeb 3.x
- By William H. M Parker <bill@amitrix.com>
- 26 Sep 1999
- DO NOT ALTER THIS FILE!
- Patterned deletes are used !
- */
-
-
- options results
- ports = show('P')
- parse var ports dummy 'AWEB.' portnr .
- address value 'AWEB.' || portnr
- 'GET ACTIVEPORT '
- awebhost=result
- address value awebhost
- 'get screen var screen'
- parse source . . called .
- c_dir=path(called)
- savewindow=''
- call startup()
- call main()
- exit
- startup:
- envname='aweb3/cachecontrol'
- abouttx='Cache Control for AWeb-II 3.x*nVers 1.4*nAuthor William Parker*nGUI by AWNPipe:'
- parse arg url
- percent=75
- days=21
- call names()
- tsite=site.0
- call buildgui()
- call cachepeek()
- return
- main:
- do while ~eof(ca)
- call topipe('con')
- in=readln(ca)
- /*say in*/
- parse var in in1 in2 in3 in4 in5 .
- if in1='gadget' then do
- call topipe('id 0 s 256')
- call gadgets()
- call topipe('id 0 s 512')
- end
- if in1='menu' then call menu()
- if in1='close' then exit
- end
- return()
- gadgets:
- if in2=pageid then return()
- if in2=reduceid then do
- 'getcfg cachedisk var cachesize'
- if rc~=0 then exit
- newsize=trunc((cachesize*(percent+1))/100,0)
- 'setcfg cachedisk 'newsize
- 'setcfg cachedisk 'cachesize
- return()
- end
- if in2=percentid then do
- percent=in3
- return()
- end
- if in2=daysid then do
- days=in3
- return()
- end
- if in2=expireid then do
- 'getcfg cachepath var cachepath'
- parse value date('N',date('I')-days,'I') with d1 d2 d3
- xdate=d1'-'d2'-'right(d3,2)
- if askabort() then return()
- address command 'list "'cachepath'" upto 'xdate' pat ~(awcr|awcu|awck) files all lformat "delete %p%n quiet" >t:cctemp'
- address command 'execute t:cctemp'
- address command 'delete t:cctemp quiet'
- 'fixcache force'
- return()
- end
- if in2=newurlid then do
- call writeln(ca,'id 0 read')
- windowr=readln(ca)
- parse var windowr wl wt ww wh .
- if (datatype(wt,N) &datatype(wl,N) &datatype(ww,N) & datatype(wh,N) ) then do
- savewindow='top' wt 'left' wl 'width' ww 'height' wh
- end
- call close(ca)
- call startup()
- call topipe('id 0 s 256');
- return()
- end
- if in2=urlid then do
- tsite=site.in3
- if tsite='' then call writeln(ca,'id 'siteid' dis 1 ')
- else call writeln(ca,'id 'siteid' dis 0 ')
- call readln(ca)
- call writeln(ca,'id 'urlloid' ref page 'pageid)
- call readln(ca)
- end
- if in2=removeid then do
- n.curnode.value=''
- 'setcfg nocache stem n'
- end
- if in2=saveid then do
- 'savesettings'
- n.curnode.value=''
- end
- if in2=editid then do
- if editgad(n.curnode.value) then do
- n.curnode.value=newname
- 'setcfg nocache stem n'
- end
- end
- if in2=newid then do
- if editgad('') then do
- n.curnode.value=newname
- 'setcfg nocache add 'newname
- end
- end
- if in2=globalid then do
- if global~=in3 then do
- if global >0 then do
- if co>0 then n.co.value=''
- if io>0 then n.io.value=''
- if oci>0 then n.oci.value=''
- 'setcfg nocache stem n'
- end
- if in3=1 then 'setcfg nocache #?.(jpg|jpeg|gif|png|iff) add'
- else if in3=2 then 'setcfg nocache ~(#?.(jpg|jpeg|gif|png|iff)) add'
- else if in3=3 then 'setcfg nocache #? add'
- end
- end
- if in2=siteid then do
- if sitem~=in3 then do
- if sitem>0 then do
- if sco>0 then n.sco.value=''
- if sio>0 then n.sio.value=''
- if sip>0 then n.sip.value=''
- 'setcfg nocache stem n'
- end
- if in3=1 then 'setcfg nocache 'tsite'#?.(jpg|jpeg|gif|png|iff) add'
- else if in3=2 then 'setcfg nocache 'tsite'~(#?.(jpg|jpeg|gif|png|iff)) add'
- else if in3=3 then 'setcfg nocache 'tsite'#? add'
- end
- end
- if in2=lbid then do
- curnode=refnum.in5
- end
- else call cachepeek()
- return()
- menu:
- if in2=0 then do
- if in3=0 then do
- if in4=0 then call setenvarc()
- if in4=1 then call unsetenvarc()
- end
- if in3=1 then 'open file:///'c_dir'CacheControl_doc.html'
- if in3=2 then call showtx(500,abouttx)
- if in3=3 then exit
- end
- return()
- names:
- a=0
- if url='' then 'get url var url'
- parse var url u1'://' u2 '/'
- root=u1'://'
- site=u2'/'
- sitel=site'|'
- site.a=site
- a=a+1
- if length(site)<2 then do
- a=0
- sitel=""
- end
- do while 1
- key=root||site
- parse var url u1 (key) u2 '/' u3
- site=site||u2'/'
- site=strip(right(site,50))
- if u3='' then do
- site=substr(url,length(root)+1)
- site=strip(right(site,40))
- sitel=sitel||site'|'
- site.a=site
- a=a+1
- site.a=''
- if sitel='|' then sitel=''
- sitel=sitel'**Show All settings**'
- a=a+1
- return
- end
- sitel=sitel||site'|'
- site.a=site
- a=a+1
- end
- return()
- buildgui:
- call getenv()
- if savewindow~='' then window=savewindow
- chtxt="Full Caching On|Do Not Cache images|Cache Only Images|Disable All Caching"
- call open(ca,'awnpipe:/xc')
- call topipe('a defg "Cache Control" v so si ps 'screen' m 'window)
- pageid=topipe('clicktab ctl "Control|Maintenance"')
- call topipe('layout v b 0 page 'pageid)
- call topipe('layout gt "Global" v so si weih 0')
- globalid=topipe('RadioButton rl "'chtxt'"')
- call topipe('le')
- urlloid=topipe('layout gt "This Site" v so si weih 0')
- call topipe('layout b 0 si so')
- newurlid=topipe('button gt N weiw 0 close')
- urlid=topipe('chooser pu cl "'sitel'" ')
- call topipe('le')
- siteid=topipe('RadioButton rl "'chtxt'"')
- call topipe('le')
- call topipe('layout gt "Current Settings" v so si')
- lbid=topipe('listbrowser arrows minh 50')
- call topipe('layout b 0 weih 0')
- editid=topipe('button gt " Edit "')
- removeid=topipe('button gt " Remove "')
- newid=topipe('button gt " New "')
- saveid=topipe('button gt " Save "')
- call topipe('le')
- call topipe('le')
- call topipe('le')
- call topipe('layout cj si v b 0 page ' pageid)
- call topipe('label gt "*nThe Expire function calls*nfix cache. It will delete all non*ncache files from your cache drawer.*n "')
- call topipe('layout v si sw cj')
- call topipe('label gt "Expire all files more than"')
- call topipe('layout b 0 sw weiw 0')
- daysid=topipe('integer defn 'days' minn 1 arrows weiw 0')
- call topipe('label gt " Days old. "')
- call topipe('le')
- expireid=topipe('button weiw 0 gt " Expire Cache Files "')
- call topipe('le')
- call topipe('space')
- call topipe('layout v si sw cj')
- call topipe('label gt "Reduce cache level to"')
- call topipe('layout b 0 sw weiw 0')
- percentid=topipe('integer defn 'percent' minn 1 maxn 99 arrows weiw 0')
- call topipe('label gt " % full. "')
- call topipe('le')
- reduceid=topipe('button weiw 0 gt " Reduce Cache Level "')
- call topipe('le')
- call topipe('label gt "*n *nThe cache maintenance functions can*n take several minutes to complete.*n "')
- call topipe('le')
- men0gad= topipe('Menu gt "Project|Window|$@SSnapshot|$@UUnsnapshot|@DCacheControl Docs|@?About|@QQuit"')
- call topipe('open')
- if sitel='**Show All settings**' then do
- call topipe('id 'siteid' dis 1 ')
- end
- return(0)
- cachepeek:
- curnode=0
- call topipe('id 'lbid' s 0 page 'pageid)
- call topipe('id 'lbid' removenode page ' pageid)
- 'getcfg nocache stem n'
- n.0.value=''
- co=0;io=0;sco=0;sio=0;sip=0;oci=0
- do i=1 for n.0
- if n.i.value='#?' then co=addnode(i)
- else if n.i.value='#?.(jpg|jpeg|gif|png|iff)' then io=addnode(i)
- else if n.i.value='~(#?.(jpg|jpeg|gif|png|iff))' then oci=addnode(i)
- else if (left(n.i.value,length(tsite))=tsite) then do
- call addnode(i)
- if n.i.value=tsite'#?' then sco=i
- if n.i.value=tsite'#?.(jpg|jpeg|gif|png|iff)' then sio=i
- if n.i.value=tsite'~(#?.(jpg|jpeg|gif|png|iff))' then sip=i
- end
- end
- if (co>0) then global=3
- else if (io>0) then global=1
- else if (oci>0) then global=2
- else global=0
- call topipe('id 'globalid' s 'global 'ref page 'pageid)
- if (sco>0) then sitem=3
- else if (sio>0) then sitem=1
- else if (sip>0) then sitem=2
- else sitem=0
- call topipe('id 'siteid' s 'sitem 'ref page 'pageid)
- return
- addnode:
- call topipe('sc ¾')
- nodeid=topipe('id 'lbid' addnode gt "'n.i.value'" page 'pageid)
- reftxt.nodeid=n.i.value
- refnum.nodeid=i
- return(i)
- editgad:
- newname=''
- call open(ca2,'awnpipe:1/xc')
- call writeln(ca2,'"Edit Cache Setting" fh so ps 'screen' defaultgadgets m a')
- call readln(ca2)
- call writeln(ca2,'layout so v minw 300')
- call readln(ca2)
- call writeln(ca2,'string lj gt "'arg(1)'" weih 0 maxchar 255')
- parse value readln(ca2) with . namegad .
- call writeln(ca2,'layout so weih 0 b 0');call readln(ca2)
- call writeln(ca2,'Button gt O.K. weih 0 close')
- parse value readln(ca2) with . okgad .
- call writeln(ca2,'Button gt Cancel weih 0 close')
- parse value readln(ca2) with . cancelgad .
- call writeln(ca2,'le ');call readln(ca2)
- call writeln(ca2,'le ');call readln(ca2)
- call writeln(ca2,'open ');call readln(ca2)
- do while ~eof(ca2)
- call writeln(ca2,'continue')
- call readln(ca2)
- parse value readln(ca2) with t tin tin2
- if t='close' then break
- if tin=namegad then newname=strip(tin2)
- end
- call close(ca2)
- if tin=okgad then return(1)
- else return(0)
- return
- topipe:
- parse arg out
- call writeln(ca,out)
- res=readln(ca)
- parse var res res1 res2 res3
- if res1='ok' then return(res2)
- say 'error from: 'out
- say ' responce: ' in
- exit
- getenv:
- if(open(env,'env:'envname,'R')) then do
- windows=readln(env)
- days=readln(env)
- if ~datatype(days,N) then days=21
- percent=readln(env)
- if ~datatype(percent,N) then percent=75
- call close(env)
- parse var windows wl wt ww wh .
- window= 'top' wt 'left' wl 'width' ww 'height' wh
- end
- else window='tl width 400 height 200'
- return
- setenv:
- call writeln(ca,'id 0 read')
- windowr=readln(ca)
- parse var windowr wl wt ww wh .
- if (datatype(wt,N) &datatype(wl,N) &datatype(ww,N) & datatype(wh,N) ) then do
- call open(env,'env:'envname,'W')
- call writeln(env,windowr)
- call writeln(env,days)
- call writeln(env,percent)
- call close(env)
- end
- return(0)
- setenvarc:
- call setenv()
- address command 'copy env:'envname' envarc:'envname '>nil:'
- return
- unsetenvarc:
- call setenv()
- if exists('envarc:'envname) then delete('envarc:'envname)
- if exists('env:'envname) then delete('env:'envname)
- return
- showtx:
- call open(ptx,'awnpipe:tbtxt/xc')
- call writeln(ptx,'ps 'screen' db dg Information q cg m a so si ')
- call writeln(ptx,'label gt "'arg(2)'"')
- call writeln(ptx,'open')
- if arg(1)=0 then call writeln(ptx,'m')
- else call writeln(ptx,'tick 'arg(1))
- call close(ptx)
- return(0)
- askabort:
- tin=''
- call open(ca2,'awnpipe:1/xc')
- call writeln(ca2,'"Cache Expire DELETE " ps 'screen' db cg dg v a')
- call readln(ca2)
- call writeln(ca2,'label gt "DELETE files from*n'cachepath'*n Created 'xdate' or earlier ? "')
- call readln(ca2)
- call writeln(ca2,'layout so ')
- call readln(ca2)
- call writeln(ca2,'button gt "DELETE FILES" close')
- parse value readln(ca2) with . deletegad .
- call writeln(ca2,'button gt "Abort" close')
- parse value readln(ca2) with . abortgad .
- call writeln(ca2,'le')
- call readln(ca2)
- call writeln(ca2,'open ');call readln(ca2)
- parse value readln(ca2) with t tin tin2
- close(ca2)
- if tin=deletegad then return(0)
- return(1);
- path:
- parse arg pathf
- dir_pos = max(lastpos('/',pathf),lastpos(':',pathf))
- if dir_pos > 0 then return(left(pathf,dir_pos))
- else return('')
-
-
-