home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-12-24 | 35.5 KB | 1,336 lines |
- /*
- $VER: AWebNews 1.7
- 22 Dec 1996
-
- AWebNews the online News Reader for AWEB-II.
- By William H. M. Parker <bill@amitrix.com>
- All Rights Reserved DO NOT DISTRIBUTE
-
-
- Plugin usage:
-
- command sys:rexxc/rx
- arguments AWeb-II:plugins/awebnews/news.awebrx %a
-
- If you don't use an AWeb-II: assign you must use
-
- arguments FullPath/news.awebrx %a
- macro Fullpath/news.awebrx
-
- Note: ARexx limits file name length so the use of the assign is preferred.
-
- */
-
- /*Show Host first response at top of page use 'on' or 'off'*/
- showstartinfo='off'
-
- /*Show calling parameters at top of page use 'on' or 'off'*/
- showcomand='off'
-
- /* CHANGE THIS SCRIPT AND YOU COULD REGRET IT !
- ... rename and wildcard delete happen
- ... external comands are enabled
- */
-
- options results
- signal on ioerr
- newsgroupsfile="newsgroups"
- maxmes=0
- lterm='0d'x
- term='.'||'0d'x
- fterm='.'||'0d'x||'0a'x
- bterm='0d'x||'0a'x||'.'||'0d'x||'0a'x
- ports = show('P')
- parse var ports dummy 'AWEB.' portnr .
- address value 'AWEB.' || portnr
- 'GET ACTIVEPORT'
- awebhost = result
- if ~show('L','rexxsupport.library') then
- if ~addlib('rexxsupport.library',0,-30,0) then
- exit(20)
-
- parse arg addr
- parse source prog_type result_flag called resolved ext host .
-
- last_slash = lastpos('/',called)
- last_colon = lastpos(':',called)
- dir_pos = max(last_slash,last_colon)
- if dir_pos > 0 then
- current_dir = left(called,dir_pos)
- else
- current_dir = ''
-
-
- address value awebhost
- address command 'delete T:configawebnews.#?.html >NIL:'
- if exists('t:awebnews.abort') then call delete('t:awebnews.abort')
- if exists('t:awebnews.ar') then call delete('t:awebnews.ar')
- fname='T:awebnews.'time(S)'.html'
- call readinfo
- if fun='ABORT' then call makeabort
- if fun='many subjects' then do
- fun='many'
- spec='sub'
- end
- if fun='all subjects' then do
- fun='all'
- spec='sub'
- end
- if fun='Kill Subject List' then do
- ft='group'
- call setclip('awnsub')
- end
- if ft='sl' then do
- ft='message'
- spec='sel'
- end
- if ft='message' & fun='post' then ft='group'
- if ft='meslist' & folu~='' then do
- ft='group'
- fun='post'
- end
-
- if sames='' & fun~='post' & fun ~='post' &ft~='post' then do
- address command 'delete T:awebnews.#?.html >NIL:'
- end
-
- if ft='' then do
- call firstinfo
- parse var addr . '"' ngroup '"' .
- if ngroup~=''then ft='group'
- end
- if many='' then many='10'
-
- if NewsHost='' then do
- call open(1,fname,w)
- call writeln(1,'<html><head><title>AWebNews Error</title></head><body>')
- call writeln(1,'<h1>AWebNews Error</h1>')
- call writeln(1,'<b>You have not configured your NewsHost.</b><p>')
- call writeln(1,'Please run ConfigNews script <br>')
- call writeln(1,'<a href="x-aweb:rexx/'current_dir'confignews.awebrx">Configuration </a>')
- call close(1)
- 'OPEN file://localhost/'fname
- 'SCREENTOFRONT'
- exit
- end
-
-
-
- call pragma(w,n)
- if ~showlist(H,'TCP') then do
- call open(1,fname,w)
- call writeln(1,'<html><head><title>AWebNews Error</title></head><body>')
- call writeln(1,'<h1>AWebNews Error</h1>')
- call writeln(1,'<b>Can not find TCP: on your system.</b><p>')
- call close(1)
- 'OPEN file://localhost/'fname
- 'SCREENTOFRONT'
- exit
- end
-
-
- if sames~='' then do
- call savemes
- 'OPEN file://localhost/'fname
- 'SCREENTOFRONT'
- exit
- end
-
- if fun='batch groups' then do
- if open(1,fname,w) then do
- call htmltop
- call batchform
- call htmlbottom
- 'OPEN file://localhost/'fname'#bpage'
- 'SCREENTOFRONT'
- 'ACTIVATEWINDOW'
- 'ALLOWCMD'
- end
- exit
- end
-
- if ft='batch' then do
- call batchchecked
- 'OPEN file://localhost/'fname'#batch'
- 'SCREENTOFRONT'
- exit
- end
- intmes='0'
-
-
- if ft='message' then do
-
- if fun = 'batch many' | fun='batch all' then do
- call postinfo
- call opennews
- if exists(bfile)then mode='A'
- else mode='W'
- if open(3,bfile,mode) then do
- bcount=0
- errlog=''
- if fun = 'batch many' then rlen= batchgroup(ngroup,many)
- if fun = 'batch all' then rlen= batchgroup(ngroup,0)
- call close(3)
- if rlen>0 then errcode=999
- end
- if open(1,fname,w) then do
- call htmltop
- call groupform
- call writeln(1,'<center><hr><a name = "batch"> </a>')
- call writeln(1,'<a name = "mesl"> </a>')
- call writeln(1,'<a name = "errlog"> </a>')
- if errcode=999 then do
- call writeln(1,'<b>Error</b><br>')
- call writeln(1,'Could not open <b>'bfile'</b><br>')
- end
-
- else do
- call writeln(1,'Error log <br>')
- call writeln(1,'Batched 'bcount 'articles to file<b> 'bfile'</b><br>')
- call writeln(1,'From 'ngroup'<br>')
- if errlog~='' then call writeln(1,'</center> Batch log ' errlog '<br>')
- end
- call writeln(1,'<center>')
- call jumps(5)
- call writeln(1,'</center>')
-
- call closenews
- call messform
-
- call htmlbottom
-
- 'OPEN file://localhost/'fname'#batch'
- 'SCREENTOFRONT'
- 'ACTIVATEWINDOW'
- 'ALLOWCMD'
- exit
- end
- end
-
- call opennews
- call subscribenews (ngroup)
- if fun='previous' then do
- nextmes=nextmes-2
- if nextmes < meslow then nextmes = meslow
- end
- maxmes = nextmes
-
- if fun = 'many' then do
- maxmes = nextmes + many -1
- if maxmes > meshi then maxmes = meshi
- end
- if fun = 'all' then maxmes = meshi
-
- if open(1,fname,w) then do
- call htmltop
- call groupform
- if spec='sub' then call subjectnews
- else do
- if spec='sel' then call selheadnews
- else call manyheadnews
- end
- call closenews
- call messform
- call htmlbottom
- call updategroup
- if spec='sub' | subkey='2' then 'OPEN file://localhost/'fname'#subl'
- else 'OPEN file://localhost/'fname'#mesl'
- call setclip('awebnewshome',fname)
- 'SCREENTOFRONT'
- 'ACTIVATEWINDOW'
- 'ALLOWCMD'
- exit
- end
- end
-
- /*external startup not from own html or aweb faking it*/
-
- if ft='' then do
- if open(1,fname,w) then do
- call htmltop
- call groupform
- call htmlbottom
- 'OPEN file://localhost/'fname'#subscribe'
- call setclip('awebnewshome',fname)
- 'SCREENTOFRONT'
- 'ACTIVATEWINDOW'
- 'ALLOWCMD'
- end
- else address command 'RequestChoice "News Reader" "Can not open t:file" "Ok" pubscreen aweb >NIL:'
- end
-
- if ft='post' then do
- call opennews
- call writeln(8,'post')
- groupinfo = readln(8)
- parse var groupinfo errcode groupinfo
- if errcode < 400 then do
- if open(1,fname,w) then do
- call htmltop
- postd = fixpostd(addr)
- call writeln(8,postd)
- call writeln(8,'.')
- groupinfo = readln(8)
- parse var groupinfo errcode groupinfo
- end
- call closenews
- call writeln(1,'<center><hr>')
- call writeln(1,'<a name = "postreply"> </a>')
- if errcode > 399 then call writeln(1,'ERROR 'errcode'<br>')
- else call writeln(1,'Posting completed<br>')
- call writeln(1,groupinfo'<br>')
- call htmlbottom
- 'OPEN file://localhost/'fname'#postreply'
- 'SCREENTOFRONT'
- 'ACTIVATEWINDOW'
- 'ALLOWCMD'
- end
- else address command 'RequestChoice "AWebNews " "'groupinfo'" "ERROR" pubscreen aweb >NIL:'
- exit
- end
-
-
- else if ft='group' then do
-
- if open(1,fname,w) then do
- if fun='post' then do
- page='ppage'
- call htmltop
- call postform
- end
-
- else do
- page='messel'
- call opennews
- call subscribenews (ngroup)
- call closenews
- call htmltop
- if errcode>399 then ngroup =ngroup' is NOT FOUND'
- else call groupcnt
- call groupform
- if errcode<400 then call messform
- else page='subscribe'
- end
-
- call htmlbottom
-
- 'OPEN file://localhost/'fname'#'page
- call setclip('awebnewshome',fname)
- 'SCREENTOFRONT'
- 'ACTIVATEWINDOW'
- 'ALLOWCMD'
- end
- end
- exit
-
-
- groupform:
- call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
- call writeln(1,'<center><hr>')
- call writeln(1,'<a name = "subscribe"></a>')
- call writeln(1,'<input type="hidden" value="group" name="ft"> ')
- call writeln(1,'Select NewsGroup or Enter NewsGroup Name ')
- call writeln(1,'<br><tt><input size=40 name="group" value='""'></tt>')
- call writeln(1,'<br><tt><select name="grouplist" size="5">')
-
- if open(7,current_dir||newsgroupsfile,r) then do
-
- groupinfo='.'
- do while groupinfo~=""
- groupinfo = readln(7)
- parse var groupinfo grp list
- if grp=ngroup then call writeln(1,'<option selected> 'grp)
- else if grp~="" then call writeln(1,'<option> 'grp)
-
- end
- call close(7)
- end
- call writeln(1,'</select></tt>')
-
- if ngroup=''then call writeln(1,'<br>No NewsGroup Set')
- else call writeln(1,'<br>Currrent NewsGroup <b>' ngroup'</b>')
- call writeln(1,'<br>')
- call writeln(1,' <input type="submit" value="Set Current Group">')
- call writeln(1,' <input type="submit" value="batch groups" name="fun">')
- if ft ~='' & right(ngroup,5)~= 'FOUND' then call writeln(1,' <input type="submit" value="post" name="fun">')
- call writeln(1,'<br>')
- call jumps(1)
- call writeln(1,'<input type="hidden" value="1" name="nmess"> ')
- call hidestate 0
- call writeln(1,'</center></form>')
- return
-
- messform:
- call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
- call writeln(1,'<center><hr>')
- call writeln(1,'<input type="hidden" value="message" name="ft"> ')
- call writeln(1,'<a name = "messel"></a>')
- call writeln(1,'<a name="mes'intmes'"></a>')
- call writeln(1,'<a name="head'intmes'"></a>')
- call writeln(1,'Current NewsGroup - <b>'ngroup '</b><br>')
- call writeln(1,' contains 'mescount' articles #'meslow' - #'meshi'<br>')
- call writeln(1,'Next Article #<input size=7 name="nmess"value="'nextmes'"> ')
- call writeln(1,'How Many ? <input size=3 name="many" value="'many'"><br> ')
-
- call writeln(1,'<input type="submit" value="many subjects" name="fun"> ')
- call writeln(1,'<input type="submit" value="all subjects" name="fun">')
- call writeln(1,' <input type="submit" value="post" name="fun"><br>')
- call writeln(1,'<input type="submit" value="read" name="fun"> ')
- call writeln(1,'<input type="submit" value="previous" name="fun"> ')
- call writeln(1,'<input name="fun" type="submit" value="many">')
- call writeln(1,' <input name="fun" type="submit" value="all">')
- call writeln(1,' --<input type="submit" value="ABORT" name="fun">--<br>')
- call scnfg(1)
- call writeln(1,'<input name="fun" type="submit" value="batch many"> ')
- call writeln(1,' <input name="fun" type="submit" value="batch all">')
- call writeln(1,' <input type="submit" value="batch groups" name="fun"><br>')
- call jumps(3)
- call hidestate 1
- call writeln(1,'</center></form>')
- return
-
- htmltop:
- call writeln(1,'<html><head><title>')
- call writeln(1,'AWebNews Reader')
- call writeln(1,'</title></head>')
- if colo='on' then call writeln(1,'<body bgcolor="'bacc'" text="'texc'">')
- if showcomand='on' then call writeln(1,addr '<br>')
- if showstartinfo='on' then call writeln(1,startinfo)
- return
-
- htmlbottom:
- call writeln(1, '<hr></body></html>')
- call close(1)
- return
-
-
- readinfo:
- parse var addr . 'colo="' colo '"' .
- parse var addr . 'bacc="' bacc '"' .
- parse var addr . 'texc="' texc '"' .
- parse var addr . 're-' folu '-' .
- parse var addr . 'sa-' sames '-' .
- parse var addr . 'host="' NewsHost '"' .
- parse var addr . 'nmess="' nextmes '"' .
- parse var addr . 'ft="' ft '"' .
- parse var addr . 'group="' ngroup '"' .
- if ngroup='' then parse var addr . 'grouplist="' ngroup '"' .
- ngroup=TRANSLATE(ngroup,xrange('a','z'), xrange('A','Z'))
- parse var addr . 'fun="' fun '"' .
- parse var addr . 'many="' many '"' .
- parse var addr . 'sho="' sho '"' .
- parse var addr . 'lho="' lho '"' .
- parse var addr . 'xprt="' xprt '"' .
- parse var addr . 'fcase="' fcase '"' .
- phil=fixphil(addr);
- parse var addr . 'philo="' philo '"' .
- parse var addr . 'scan="' scan '"' .
- return
-
-
- opennews:
- call openpro
- call writeln(con,'Waiting for Host')
- if ~ open(8,'tcp:'NewsHost'/119',w) then do
- address command 'RequestChoice "AWebNews " "Can Not Open Host 'NewsHost'" "Ok" pubscreen aweb >NIL:'
- exit
- end
- startinfo = readln(8)
- parse var startinfo errcode startinfo
- call writeln(con,startinfo)
- return
-
- closenews:
- call writeln(8,'QUIT')
- call close(8)
- if progo='o' then call close(con)
- progo=''
- return
-
- subscribenews:
- parse arg tgroup
- call writeln(8,'group 'tgroup)
- groupinfo = readln(8)
- call writeln(con,'0c'x ngroup )
- parse var groupinfo errcode mescount meslow meshi .
- return 0
-
-
- manyheadnews:
-
- if nextmes < meslow then return
- if nextmes > meshi then return
- errlog=''
- oldnextmes=nextmes
- call meslisttop
- call writeln(con,' ' )
- do while nextmes <= maxmes
- if exists('T:AWebNews.ABORT') then do
- if tryabort()="" then do
- maxmes=nextmes
- errlog=errlog||'<br> ABORT at ' nextmes '<br>'
- end
- end
- call headnews
- nextmes = nextmes + 1
- end
-
- call writeln(1,'<hr><b>' ngroup '</b> Article Texts' )
- call writeln(1,'-<a href="file://localhost/'current_dir'AWebNews_doc.html#form_scan_ng">Help</a>')
- call writeln(1,' - <a href="#errlog" >error log</a>')
- call mesnews
- call writeln(1,'<hr><a name="errlog"></a><center>')
- call jumps(0)
- call writeln(1,'Error Log</center>')
- if errlog~='' then call writech(1,errlog)
- else call writech(1,'No Errors ')
- call meslistbottom
- return
-
-
- meslisttop:
- call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
- call writeln(1,'<a name="mesl"></a>')
- call writeln(1,'<input type="hidden" value="meslist" name="ft"> ')
-
- if scan='on' then do
- call writeln(1,'<hr><b> ' ngroup '</b> article Index List</b>' )
- call writeln(1,'-<a href="file://localhost/'current_dir'AWebNews_doc.html#form_scan_ng">Help</a>')
- call writeln(1,' - <a href="#errlog" >error log</a>')
- end
- return
-
- meslistbottom:
-
- call hidestate 0
- call writeln(1,'</form>')
-
- return
-
-
- groupcnt:
- if ~open(7,current_dir||newsgroupsfile,r) then call open(7,current_dir||newsgroupsfile,w)
- do
-
- groupinfo = readln(7)
- parse var groupinfo grp cnt .
-
- do while grp~ = ngroup & groupinfo ~= ''
- groupinfo = readln(7)
-
- parse var groupinfo grp cnt .
- end
- if grp=ngroup then nextmes = cnt
- else call writeln(7,ngroup meslow)
- call close(7)
-
- end
- if nextmes='' | nextmes < meslow then nextmes = meslow
- return
-
- updategroup:
- if open(6,current_dir||newsgroupsfile'.new',w) then do
- if open(7,current_dir||newsgroupsfile,r) then do
- do until groupinfo = ''
- groupinfo = readln(7)
- parse var groupinfo grp cnt xtra .
- if ft='batch' then do
- if grp = ngroup then call writeln(6,grp nextmes ' batch')
- else if grp~='' then call writeln(6,grp cnt xtra)
- end
- else do
- if grp = ngroup then call writeln(6,grp nextmes xtra)
- else if grp~='' then call writeln(6,grp cnt xtra)
- end
-
- end
- call close(7)
- end
- call close(6)
- if exists(current_dir||newsgroupsfile) then call delete(current_dir||newsgroupsfile)
- call rename(current_dir||newsgroupsfile'.new', current_dir||newsgroupsfile)
- end
-
- return
- cleargroup:
- if open(6,current_dir||newsgroupsfile'.new',w) then do
- if open(7,current_dir||newsgroupsfile,r) then do
- do until groupinfo = ''
- groupinfo = readln(7)
- parse var groupinfo grp cnt xtra
- if grp~='' then call writeln(6,grp cnt )
-
- end
- call close(7)
- end
- call close(6)
- if exists(current_dir||newsgroupsfile) then call delete(current_dir||newsgroupsfile)
- call rename(current_dir||newsgroupsfile'.new', current_dir||newsgroupsfile)
- end
-
- return
-
- firstinfo:
- if open(2,current_dir||'newsconfig',r) then do
- configinfo = readch(2,3000)
-
- parse var configinfo . 'colo ' colo '0a'x
- parse var configinfo . 'texc ' texc '0a'x
- parse var configinfo . 'bacc ' bacc '0a'x
- parse var configinfo . 'bfile ' bfile '0a'x
- parse var configinfo . 'host ' NewsHost '0a'x
- parse var configinfo . 'many ' many '0a'x
- parse var configinfo . 'sho ' sho '0a'x
- parse var configinfo . 'lho ' lho '0a'x
- parse var configinfo . 'scan ' scan '0a'x
- parse var configinfo . 'phil ' phil '0a'x
- parse var configinfo . 'philo ' philo '0a'x
- parse var configinfo . 'fcase ' fcase '0a'x
- call close(2)
- end
- return
-
- postform:
-
- call postinfo
- call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
- call writeln(1,'<a name="ppage"></a>')
- call writeln(1,'<input type="hidden" value="post" name="ft"> ')
- call writeln(1,'<hr><a name = "messel"> </a>')
- call writeln(1,'<center>Post an Article')
- call writeln(1,'-<a href="file://localhost/'current_dir'AWebNews_doc.html#form_post">Help</a>')
- call writeln(1,'<textarea name="postd" cols='taw' rows='tah'>')
- subject=''
- from=''
- mdate=''
- if folu~='' then do
- call opennews
- call subscribenews (ngroup)
- call writeln(8,'head ' folu)
- mesinfo = readln(8)
- parse var mesinfo errcode mesinfo
- if errcode <400 then do
- do until scaninfo = term
- scaninfo = readln(8)
- if subject='' then parse var scaninfo . 'Subject:' subject '0d'x
- if from='' then parse var scaninfo . 'From:' from '0d'x
- if mdate='' then parse var scaninfo . 'Date:' mdate '0d'x
- end
- end
- if left(subject,3) ~= ' re' & left(subject,3) ~= ' Re' then subject =' Re:'subject
- end
-
-
- call writeln(1,'NewsGroups: 'ngroup)
- if disto='on' then call writeln(1,'Distribution: 'disth)
- if heado='on' then do
- if open(3,headf,r) then do
- do until headinfo = ''
- headinfo=readln(3)
- if headinfo~="" then call writeln(1,fixhtml(headinfo))
- end
- call close(3)
- end
- end
- call writeln(1,'X-Newsreader: AWebNews ')
- if repo='on' then call writeln(1,'Reply-To: 'fixhtml(reph))
- call writeln(1,'From: 'fixhtml(eadr))
- call writeln(1,'Subject:'fixhtml(subject) )
- call writeln(1,'' )
- call writeln(1,'--' )
- if folu~='' then do
- call writeln(1,'On 'mdate', 'fixhtml(from)' wrote ...' )
-
- if qhead='on'then do
- call writeln(8,'head ' folu)
- mesinfo = readln(8)
- parse var mesinfo errcode mesinfo
- if errcode <400 then do
- do until scaninfo = term
- scaninfo = readln(8)
-
- if scaninfo ~= term then call writeln(1,' > 'fixhtml(scaninfo))
- end
- end
- end
-
- if qbody='on'then do
- call writeln(8,'body ' folu)
- mesinfo = readln(8)
- parse var mesinfo errcode mesinfo
- if errcode <400 then do
- do until scaninfo = term
- scaninfo = readln(8)
- if scaninfo ~= term then call writeln(1,' > 'fixhtml(scaninfo))
- end
- end
- end
- call writeln(1,'--' )
-
- end
-
- if sigo='on' then do
- if open(3,sigf,r) then do
- do until siginfo = ''
- siginfo=readln(3)
- call writeln(1,fixhtml(siginfo))
- end
- call close(3)
- end
- end
- call writeln(1,'</textarea>')
- call hidestate 0
- call writeln(1,'<input type="submit" value="Post Article"></form>')
- return
-
- postinfo:
-
- if open(2,current_dir||'newsconfig',r) then do
- configinfo = readch(2,3000)
- parse var configinfo . 'bfile ' bfile '0a'x
- parse var configinfo . 'eadr ' eadr '0a'x
- parse var configinfo . 'disto ' disto '0a'x
- parse var configinfo . 'disth ' disth '0a'x
- parse var configinfo . 'repo ' repo '0a'x
- parse var configinfo . 'reph ' reph '0a'x
- parse var configinfo . 'sigo ' sigo '0a'x
- parse var configinfo . 'sigf ' sigf '0a'x
- parse var configinfo . 'heado ' heado '0a'x
- parse var configinfo . 'headf ' headf '0a'x
- parse var configinfo . 'qhead ' qhead '0a'x
- parse var configinfo . 'qbody ' qbody '0a'x
- parse var configinfo . 'tah ' tah '0a'x
- parse var configinfo . 'taw ' taw '0a'x
- parse var configinfo . 'spath ' spath '0a'x
-
- call close(2)
- end
- return
-
- savemes:
-
- call postinfo
- address command ' requestfile >t:awebnews.ar savemode 'spath' file 'ngroup'.'sames' title "AWebNews Article Save" positive SAVE pubscreen aweb'
- if rc>0 then exit
- call open(3,'t:awebnews.ar',r)
- savename=readch(3,300)
- call close(3)
- parse var savename '"' savename '"'
- if open(3,savename,w) then do
- call opennews
- call subscribenews (ngroup)
- if readtostr(article,sames)>0 then call writech(3,left(scaninfo,length(scaninfo)-3))
- call closenews
- call close(3)
- end
- else do
- errcode=999
- mesinfo='Could not open <b> 'savename'</b>'
- end
-
- if open(1,fname,w) then do
- call htmltop
- if errcode>399 then do
- call writeln(1,'<h1>AWebNews Error</h1>')
- call writeln(1,'<b>Article not saved</b><p>')
- call writeln(1,mesinfo'<p>')
- end
- else
- call writeln(1,'<h2> Article Saved O.K.</h2><p>')
- call writeln(1,savename '<p>')
- end
- call htmlbottom
- return
-
- readtostr:
- parse arg comtype,temp
- call writeln(8,comtype' 'temp)
- mesinfo = readln(8)
- parse var mesinfo errcode mesinfo
- if errcode>399 then return 0
- scaninfo=""
- do until lineinfo=term
- lineinfo = readln(8)
- scaninfo = scaninfo||lineinfo
- end
- scaninfo= TRANSLATE(scaninfo,'0a'x , '0d'x )
- return length(scaninfo)
-
- batchgroup:
-
- parse arg tgroup,btemp
- ngroup =tgroup
-
- call subscribenews(tgroup)
- call writeln(con,' ' )
- if errcode<400 then do
- if nextmes='' then call groupcnt
- if btemp=0 then maxmes = meshi
- else maxmes = nextmes + btemp - 1
- if maxmes > meshi then maxmes = meshi
- if nextmes<=maxmes then errlog=errlog||'<br>'tgroup' o.k., getting 'nextmes'- 'maxmes
- else errlog=errlog||'<br>'tgroup' o.k., no articles'
- btemp=0
- do while nextmes<=maxmes
- call writeln(con,'9b41'x maxmes - nextmes +1 ' ')
- if exists('T:AWebNews.ABORT') then do
- if tryabort()="" then do
- maxmes=nextmes
- listwork=''
- errlog=errlog||'<br> ABORT at ' nextmes '<br>'
- end
- end
- rlen = readtostr(article,nextmes)
- if philo='on' & filter(scaninfo)=0 then do
- rlen=0
- mesinfo='filtered out'
- end
-
- if rlen > 0 then do
- call = writeln(3,'#! rnews' length(scaninfo)-2)
- rlen= writech(3,left(scaninfo,length(scaninfo)-2))
- end
- else errlog=errlog||'<br> - 'tgroup||' 'nextmes' '||mesinfo
-
-
- nextmes=nextmes+1
- btemp=btemp+1
- end
- bcount=bcount+btemp
- call updategroup
- return 0
- end
- else errlog=errlog||'<br>NO GROUP 'tgroup||' '||groupinfo
-
- return 1
-
-
- fixhtml: procedure
- parse arg a
- a=a'-'
- c=''
- parse var a b '&' a
- do while a~=''
- c=c||b'&'
- parse var a b '&' a
- end
- a=c||b
-
- c=''
- parse var a b '<' a
- do while a~=''
- c=c||b'<'
- parse var a b '<' a
- end
- a=c||b
- c=''
-
- parse var a b '>' a
- do while a~=''
- c=c||b'>'
- parse var a b '>' a
- end
- a=c||b
- return left(a,length(a)-1)
-
- fixta: procedure
- parse arg a
- a=fixhtml(a)
- a=a'-'
- c=''
- parse var a b '"' a
- do while a~=''
- c=c||b'"'
- parse var a b '&' a
- end
- a=c||b
- return left(a,length(a)-1)
-
-
- batchform:
- call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
- call writeln(1,'<a name="bpage"></a>')
- call writeln(1,'<hr><center>')
- call writeln(1,'Select NewsGroups to Batch')
- call writeln(1,'<br><select multiple name="grouplist" size="5">')
-
- if open(7,current_dir||newsgroupsfile,r) then do
-
- groupinfo='.'
- do while groupinfo~=""
- groupinfo = readln(7)
- parse var groupinfo grp tmes bstat list
- if grp~="" then do
- if bstat ='batch' then call writeln(1,'<option selected> 'grp)
- else call writeln(1,'<option> 'grp)
- end
- end
- call close(7)
- end
- call writeln(1,'</select><br>')
- call writeln(1,' <input type="submit" value="batch checked groups">')
- call writeln(1,' --<input type="submit" value="ABORT" name="fun">--<br>')
- call scnfg(0)
- call writeln(1,'<input type="hidden" value="batch" name="ft"> ')
- call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_batch_ng">Help</a> - ')
- call writeln(1,'<a href="x-aweb:rexx/'current_dir'news.awebrx">Read News </a>')
- call writeln(1,' - <a href="x-aweb:rexx/'current_dir'confignews.awebrx">Config / Maintain Groups </a>')
- call hidestate 0
- call writeln(1,'</form>')
- return
-
- batchchecked:
- call postinfo
- call cleargroup
- if exists(bfile) then mode='A'
- else mode='W'
- if open(3,bfile,mode) then do
- bcount=0
- errlog=''
- call opennews
- listwork=addr
- do until nextgrp=''
- parse var listwork . 'grouplist="' nextgrp '"' listwork
- if nextgrp~='' then do
- nextmes=''
- call batchgroup(nextgrp,0)
- end
- end
- call closenews
- call close(3)
- end
- else errcode =999
- if open(1,fname,w) then do
- call htmltop
- call batchform
- call writeln(1,'<hr><a name = "batch"></a><center>Error log<br>')
- if errcode=999 then do
- call writeln(1,'<b>Error</b><br>')
- call writeln(1,'Could not open 'bfile'<br>')
- end
-
- else do
- call writeln(1,'Batched 'bcount 'articles to file <b>'bfile'</b><br>')
- call writeln(1,'From Selected Groups</center>')
- if errlog~=''then call writeln(1,'<br> Batch log'errlog '<br>')
- end
- call writeln(1,'<center>')
- call jumps(6)
- call writeln(1,'</center>')
- call htmlbottom
- end
- return
-
-
- headnews:
- if spec='sel' then call writeln(con,'9b41'x nextmes ' ')
- else call writeln(con, '9b41'x maxmes-nextmes+1 ' ')
- rlen= readtostr(article,nextmes)
- if philo='on' & filter(scaninfo)=0 then do
- errcode=888
- mesinfo='filtered out'
- end
-
- if errcode<400 then do
- mesfound='y'
- scaninfo=makelink(fixhtml(scaninfo))
- call setclip('awebnews_'nextmes,scaninfo)
- if scan='on' then do
-
- parse var scaninfo scaninfo '0a0a'x bodyinfo
- parse var scaninfo 'Reply-To:' reply '0a'x
- parse var scaninfo 'Subject:' subject '0a'x
- parse var scaninfo 'From:' from '0a'x
- parse var scaninfo 'Date:' mdate '0a'x
-
- call writeln(1,'<hr><center>')
- call writeln(1,' #'nextmes)
- call writeln(1,' - <a href="#mes'intmes'" >read</a>')
-
- call writeln(1,' - <a href="#head'intmes+1'" name="head'intmes'">next</a>')
- if intmes>0 then call writeln(1,' - <a href="#head'intmes-1'" >previous</a>')
- call writeln(1,' - <a href="#mesl" >top</a> - <a href="#messel"> more</a>')
- call writeln(1,' - <input type="submit" value="follow up" name="re-'nextmes'-">')
- call writeln(1,' - <input type="submit" value="save" name="sa-'nextmes'-">')
- intmes=intmes+1
- call writeln(1,'<br>')
- call writeln(1,'</center>')
- call writeln(1,' Subject : 'subject'<br>')
- call writeln(1,' Date : 'mdate'<br>')
- if reply~=''then do
- call writeln(1,'Reply-To: <A HREF="mailto:'fixmailto(reply)'"><I>'reply'</I></A><BR>')
- call writeln(1,' From: 'from)
- end
- else call writeln(1,'From: <A HREF="mailto:'fixmailto(from)'"><I>'from'</I></A>')
-
- end
- end
- else errlog=errlog||'Article not found 'nextmes' 'mesinfo'<br>'
- return
-
- mesnews:
- if mesfound~='y' then do
- call writeln(1,' No articles retreived.<br>')
- return
- end
- intmes=0
- clips= show('C')
- call writeln(con,'0c'x 'processing')
-
- do while clips~=''
- parse var clips 'awebnews_' clipmes clips
- if clipmes~='' then do
- call writech(con,'.')
- scaninfo= getclip('awebnews_'clipmes)
- parse var scaninfo scaninfo '0a0a'x bodyinfo
-
- call writeln(1,'<hr> <center># 'clipmes )
- if scan ='on' then call writeln(1,' - <a href="#head'intmes'" >Index</a>')
- call writeln(1,' - <a href="#mes'intmes+1'" name="mes'intmes'">next</a>')
- if intmes>0 then call writeln(1,' - <a href="#mes'intmes-1'" >previous</a>')
- call writeln(1,' - <a href="#mesl" >top</a> - <a href="#messel"> more</a>')
- call writeln(1,' - <input type="submit" value="follow up" name="re-'clipmes'-">')
- call writeln(1,' - <input type="submit" value="save" name="sa-'clipmes'-">')
- intmes=intmes+1
- call writeln(1,'</center>')
-
- if sho='on'then do
- parse var scaninfo 'Reply-To: ' reply '0a'x
- parse var scaninfo 'Subject:' subject '0a'x
- parse var scaninfo 'From:' from '0a'x
- parse var scaninfo 'Date:' mdate '0a'x
-
- call writeln(1,' Subject : 'subject'<br>')
- call writeln(1,' Date : 'mdate'<br>')
- if reply~=''then do
- call writeln(1,'Reply-To: <A HREF="mailto:'fixmailto(reply)'"><I>'reply'</I></A><BR>')
- call writeln(1,' From: 'from)
- end
- else call writeln(1,'From: <A HREF="mailto:'fixmailto(from)'"><I>'from'</I></A>')
- end
- if lho='on' then do
- call writeln(1,'<pre >')
- call writeln(1,scaninfo)
- call writeln(1,'</pre>' )
- end
- call writeln(1,'<br><pre>')
- if sho~='on' & h~='on' then do
- parse var scaninfo 'Subject:' subject '0a'x
- call writeln(1,' Subject : 'subject)
- end
- if length(bodyinfo)>2 then call writeln(1,left(bodyinfo,length(bodyinfo)-2))
- call writeln(1,'</pre>' )
- call setclip('awebnews_'clipmes)
- end
- end
- return
-
- fixpostd: procedure
- parse arg a
- c=''
- parse var a b '*"' a
- do while a~=''
- c=c||b'*q'
- parse var a b '*"' a
- end
- a=c||b
- parse var a . 'postd="' a '"' .
- c=''
- parse var a b '*' a
- do while a~=''
- d=left(a,1)
- if d='N' then c=c||b||'0a'x
- else if d='q' then c=c||b||'"'
- else if d='"'|d='*'|d="'"|d='$'then c=c||b||d
- else do
- c=c||b||'*'
- a=d||a
- end
- parse VALUE (substr(a,2)) WITH b '*' a
- end
- return c||b
-
- fixphil: procedure
- parse arg a
- c=''
- parse var a b '*"' a
- do while a~=''
- c=c||b'*q'
- parse var a b '*"' a
- end
- a=c||b
- parse var a . 'phil="' a '"' .
- c=''
- parse var a b '*' a
- do while a~=''
- d=left(a,1)
- if d='N' then c=c||b||'0a'x
- else if d='q' then c=c||b||'"'
- else if d='"'|d='*'|d="'"|d='$'then c=c||b||d
- else do
- c=c||b||'*'
- a=d||a
- end
- parse VALUE (substr(a,2)) WITH b '*' a
- end
- return c||b
-
- ioerr:
- address command 'RequestChoice "AWebNews " "'NewsHost' not responding" "Ok" pubscreen aweb >NIL:'
- exit
-
- openpro:
- if progo='o' then call close(con)
- call open(con,'con://300/50/AWebNews ' NewsHost'/close/inactive/screen aweb')
- progo='o'
- return
-
- filtersubjects:
- procedure expose phil fcase
- parse arg a
- c=''
- do while a~=''
- parse var a b '0a'x a
- if filter(b) =1 then c=c||b||'0a'x
- end
- return c
-
-
- subjectnews:
- call writeln(con,'Subjects ' maxmes-nextmes+1)
- rlen= readtostr('xhdr Subject',nextmes'-'maxmes)
- if errcode<400 then do
- if philo='on' then scaninfo=filtersubjects(scaninfo)
- scaninfo=fixhtml(scaninfo)
- if ngroup=getclip('awnoldngroup')then scaninfo=getclip('awnsub')||scaninfo
- call setclip('awnsub',left(scaninfo,length(scaninfo)-2))
- call setclip('awnoldngroup',ngroup)
- nextmes = maxmes+1
- call updategroup
- call subjectform
- end
- return
-
- subjectform:
- scaninfo=getclip('awnsub')
- call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
- call writeln(1,'<center><hr><a name = "subl"></a>')
-
- if scaninfo='' then do
- call writeln(1,'No articles in subject list.<br>')
- end
- else do
- call writeln(1,' <a name="mes'intmes'"></a>')
- call writeln(1,' <a name="mes'intmes'"></a>')
- call writeln(1,'Subjects from articles in <b>' ngroup'</b>')
-
- call writeln(1,'<br><select multiple name="sublist" size="10">')
-
- do while scaninfo~=''
- parse var scaninfo subject '0a'x scaninfo
- if subject~='.'then call writeln(1,'<option> 'left(subject,75))
- end
- call writeln(1,'</select><br>')
- call writeln(1,' <input type="submit" value="Read selected articles" name="fun">')
- call writeln(1,' <input type="submit" value="Read all articles" name="fun">')
- call writeln(1,' --<input type="submit" value="ABORT" name="fun">--<br>')
- call writeln(1,' <input type="submit" value="Kill selected articles" name="fun">')
- call writeln(1,' <input type="submit" value="Kill Subject List" name="fun"><br>')
- call scnfg(1)
- end
- call jumps(2)
- call writeln(1,'<input type="hidden" name="ft" value="sl">')
- call hidestate 1
- call writeln(1,'<center></form>')
- return
-
- selheadnews:
- errlog=''
- oldnextmes=nextmes
- subt=getclip('awnsub')
- if fun='Read selected articles' then do
- parse var addr subs
- subkey='0'
- end
- if fun='Read all articles' then do
- subkey='1'
- subs=subt
- end
- if fun='Kill selected articles' then do
- subkey='2'
- parse var addr subs
- end
- if subkey~='2' then call meslisttop
- call writeln(con,' ' )
- do while subs~=''
- if subkey='1' then parse var subs nextmes . '0a'x subs
- else parse var subs . 'sublist="'nextmes ' ' subs
- parse var subt subt (nextmes) '0a'x subtt
- subt=subt||subtt
- if exists('T:AWebNews.ABORT') then do
- if tryabort()="" then do
- subs=''
- errlog=errlog||'<br> ABORT at ' nextmes '<br>'
- end
- end
-
- if nextmes~='' & subkey~='2' then call headnews
- end
- call setclip('awnsub',subt)
- nextmes=oldnextmes
-
- if subkey~='2' then do
- call writeln(1,'<hr><b>' ngroup '</b> Selected Texts' )
- call writeln(1,'- <a href="file://localhost/'current_dir'AWebNews_doc.html#form_scan_ng">Help</a>')
- call writeln(1,' - <a href="#errlog" >error log</a>')
- call mesnews
- call writeln(1,'<hr><a name="errlog"></a><center>')
- call jumps(4)
- call writeln(1,'Error Log</center>')
- if errlog~='' then call writech(1,errlog)
- else call writech(1,'No Errors ')
- call meslistbottom
- end
- call subjectform
- return
-
-
- hidestate:
- parse arg jt
- call writeln(1,'<input type="hidden" name="colo" value="'colo'">')
- call writeln(1,'<input type="hidden" name="bacc" value="'bacc'">')
- call writeln(1,'<input type="hidden" name="texc" value="'texc'">')
- call writeln(1,'<input type="hidden" value="'NewsHost'" name="host"> ')
- call writeln(1,'<input type="hidden" value="'many'" name="many"> ')
- if jt~=1 then do
- call writeln(1,'<input type="hidden" value="'fcase'" name="fcase"> ')
- call writeln(1,'<input type="hidden" value="'phil'" name="phil"> ')
- call writeln(1,'<input type="hidden" value="'philo'" name="philo"> ')
- call writeln(1,'<input type="hidden" value="'sho'" name="sho"> ')
- call writeln(1,'<input type="hidden" value="'lho'" name="lho"> ')
- call writeln(1,'<input type="hidden" value="'scan'" name="scan"> ')
- end
- call writeln(1,'<input type="hidden" value="'ngroup'" name="group"> ')
- call writeln(1,'<input type="hidden" value="'nextmes'" name="nmess"> ')
- return
-
-
- makelink: procedure
- parse arg a
- c=''
- do while a~=''
- parse var a d 'http://' b a
- c=c||d
- if b~='' then do
- t= length(b)
- parse var b b '0a'x d
- c=c|| '<a href="http://' || b || '">http://' || b || '</a>'
- if length(b)~=t then c= c || '0a'x || d
- end
- end
- return c
-
- filter: procedure expose phil fcase
- parse arg t
- t=upper(t)
- a=phil
- if fcase='on' then a=upper(a)
- do until a=''
- parse var a b ',' a
- if left(b,1)='-' then do
- if index(t,right(b,length(b)-1))>0 then t=''
- end
- if left(b,1)='+' then do
- if index(t,right(b,length(b)-1))=0 then t=''
- end
- if left(b,1)='|' then do
- if t~='' then return 1
- parse arg t
- if fcase='on' then t=upper(t)
- end
- if left(b,1)='~' then do
- if t='' then do
- parse arg t
- if fcase='on' then t=upper(t)
- end
- else t=''
- end
- end
- if t~='' then return 1
- return 0
-
- scnfg:
- parse arg st
- call writeln(1,'<hr width =50%>')
- if st=1 then do
- if scan = 'on' then call writeln(1,'Index List<input type="checkbox" checked name="scan"> ')
- else call writeln(1,'Index List <input type="checkbox" name="scan"> ')
- if sho = 'on' then call writeln(1,'Short Header <input type="checkbox" checked name="sho"> ')
- else call writeln(1,'Short Header <input type="checkbox" name="sho"> ')
- if lho = 'on' then call writeln(1,'Long Header <input type="checkbox" checked name="lho"> ')
- else call writeln(1,'Long Header <input type="checkbox" name="lho"> ')
- call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#display"> Help</a>')
- call writeln(1,'<br>')
- end
- call writeln(1,'Filter <input size=30 name="phil" value="'fixta(phil)'">')
- if fcase = 'on' then call writeln(1,' Ignore Case <input type="checkbox" checked name="fcase"> ')
- else call writeln(1,' Ignore Case <input type="checkbox" name="fcase"> ')
- if philo = 'on' then call writeln(1,' Use Filter <input type="checkbox" checked name="philo"> ')
- else call writeln(1,' Use Filter <input type="checkbox" name="philo">')
- call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#filter"> Help </a>')
- call writeln(1,'<br>')
- return
- jumps:
- parse arg jt
- if jt=1 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_select_ng">Help</a>-')
- if jt=3 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_curr_ng">Help</a>-')
- if jt=2 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_subject">Help</a>-')
- if jt=4 | jt=0 | jt=5 | jt=6 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#error_log">Help</a>-')
-
- if jt=6 then call writeln(1,'<a href="#bpage" > Batch Groups</a> - ')
- if jt~=1 & jt~=6 then call writeln(1,'<a href="#subscribe" > New Group</a> - ')
- if ft='message' then do
- if spec='sub' | spec='sel' then do
- if jt~=2 then call writeln(1,'<a href="#subl">Subjects</a> - ')
- end
- if spec~='sub' then do
- if left(fun,5)~='batch' then call writeln(1,'<a href="#mesl"> Article Texts</a> - ')
- end
- if jt~=3 then call writeln(1,'<a href="#messel"> Get More Articles</a> - ')
- end
- if ft='group' & right(ngroup,5)~= 'FOUND' then do
- if jt~=3 then call writeln(1,'<a href="#messel"> Get Articles</a> - ')
- end
- call writeln(1,'<a href="x-aweb:rexx/'current_dir'confignews.awebrx">Config / Maintain Groups </a><br>')
-
- return
-
- tryabort:
- procedure
- call delete('t:awebnews.abort')
- address command ' requestchoice AWebNews "Abort Request" Continue Abort pubscreen aweb >t:awebnews.ar'
- call open(2,'t:awebnews.ar',r)
- t=readch(2,1)
- call close(2)
- if t='0' then return('')
- return (1)
-
-
- makeabort:
- procedure
- if open(1,'t:AWebNews.ABORT',w) then call close(1)
- exit
-
- fixmailto:
- procedure
- parse arg a
- parse var a '<' b '>'
- if b~='' then return b
- c=a
- do while a~=''
- parse var a b a
- if index(b,'@')>0 then return b
- end
- return strip(c)
-
-