/*
 $VER: GetNET.Thor 1.2 (6.5.96)
 by Remco van Hooff
*/

bbs       = 'News&Mail'        /* your Email system */

/* hotlists */
hotlist_amosaic = 'envarc:mosaic/.mosaic-hotlist-default' ; amosaic = 1
hotlist_ibrowse = 'AmiTCP:IBrowse/prefs/ibrowse-hotlist.html'          ; ibrowse = 1
hotlist_aweb    = 'AmiTCP:AWeb/aweb.hotlist'                     ; aweb    = 1
hotlist_voyager = 'AmiTCP:/Voyager/bookmarks.html'                ; voyager = 1
hotlist_html    = 'AmiTCP:bin/lynx_bookmarks.html'          ; html    = 0

/* loop or not */
loop = 0

/* don't edit these */
cr = '0d'x
lf = '0a'x
tab= '09'x

/* filter chars, expand if you want */

/* after the address */
filter.1.1 = cr
filter.1.2 = lf
filter.1.3 = ')'
filter.1.4 = ','
filter.1.5 = "'"
filter.1.6 = '"'
filter.1.7 = ']'
filter.1.8 = '>'
filter.1.9 = '}'
filter.1.10 = '*'
filter.1.count = 10 /* number of filters */

/* in front of the address */
filter.2.1 = '('
filter.2.2 = '"'
filter.2.3 = '<'
filter.2.4 = '['
filter.2.5 = '{'
filter.2.6 = ':'
filter.2.7 = "'"
filter.2.8 = tab
filter.2.count = 8

tempfile  = 't:temp.tmp'

/*--------------------------------------------------------------------------*/
OPTIONS FAILAT 31
p = ADDRESS() || ' ' || SHOW('P',,)
thorport = POS('THOR.',p)
IF thorport > 0 THEN thorport = WORD(SUBSTR(p,thorport),1)
ELSE DO
  SAY 'THOR port not found!'
  EXIT 10
END

IF ~SHOW('p', 'BBSREAD') THEN DO
  ADDRESS COMMAND
    "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
    "WaitForPort BBSREAD"
END

ADDRESS(thorport)
OPTIONS RESULTS

CURRENTMSG stem MSG
IF(RC ~= 0) THEN DO
  REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  EXIT
END
msgnum  = MSG.MSGNR
curbbs  = MSG.BBSNAME
curconf = MSG.CONFNAME

ADDRESS bbsread READBRMESSAGE BBSNAME '"'curbbs'"' CONFNAME '"'curconf'"' MSGNR msgnum HEADSTEM headtags
IF(RC ~= 0) THEN DO
  REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  EXIT
END
fromname = HEADTAGS.FROMNAME
subj = HEADTAGS.SUBJECT
IF POS('RE:',UPPER(subj)) ~=0 THEN subj = SUBSTR(subj,5)

CALL main
EXIT

main:
  DROP FOUND. SAVE. NAME.
  REQUESTNOTIFY TEXT '"Choose what kind of addresses to get."' BT '"_HTTP|_Email|_Quit"'
  IF RESULT = 0 THEN EXIT
  IF RESULT = 1 THEN CALL get_http
  IF RESULT = 2 THEN CALL get_email
  IF loop = 1 THEN SIGNAL main
RETURN

/* gethttp */
get_http:
SAVEMESSAGE CURRENT FILENAME tempfile NOANSI OVERWRITE
IF(RC ~= 0) THEN DO
  REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  EXIT
END

ELSE DO
  CALL gethttp
  CALL listfound
  IF ok = 1 THEN CALL listsave(1)
END
RETURN

gethttp:
  CALL OPEN(tmp, tempfile, 'r')
    num = 0
    found.count = 0
    DO WHILE ~EOF(tmp)
      msg = READLN(tmp)
      msg = TRANSLATE(msg, 'hpt', 'HPT')
      PARSE VAR msg . 'ttp://' httpadres .
      IF httpadres ~= '' THEN DO
        lengte = length(httpadres)
        CALL filter(httpadres, lengte,1)
        httpadres = 'http://'||RESULT
        n = 0
        DO i = 1 TO found.count
          IF httpadres ~= found.i THEN n = n +1
        END        
        IF n = found.count THEN DO
          num = num + 1
          found.num = httpadres
          found.count = num
        END
      END
    END
  CALL CLOSE(tmp)
  ADDRESS COMMAND 'delete >nil: 'tempfile
RETURN

savehotlist:
  DO i = 1 TO save.count
    IF name.i = '' THEN name.i = subj '('i')'
  END
  IF amosaic = 1 THEN CALL save_amosaic
  IF ibrowse = 1 THEN CALL save_ibrowse
  IF html    = 1 THEN CALL save_html
  IF aweb    = 1 THEN CALL save_aweb
  IF voyager = 1 THEN CALL save_voyager
  IF amosaic+ibrowse+html+aweb+voyager = 0 THEN Requestnotify '"No hotlist(s) selected."' '"_OK"'
  IF loop = 1 THEN SIGNAL main
RETURN

save_amosaic:
  IF ~EXISTS(hotlist_amosaic) THEN DO
    Requestnotify '"Amosaic hotlist not found!"' '"_OK"'
    RETURN
  END
  ELSE DO
    dat = DATE()
    PARSE VAR dat dagnr maand jaar
    dag = LEFT(DATE('W', DATE(S), 'S'), 3)
    datum = dag maand dagnr TIME()jaar
    CALL OPEN(htlst,hotlist_amosaic,'a')
    DO i = 1 TO save.count
      CALL WRITELN(htlst,save.i||' '||datum)
      CALL WRITELN(htlst,STRIP(name.i))
    END
    CALL CLOSE(htlst)
  END
  ADDRESS COMMAND 'copy' hotlist_amosaic 'env:mosaic/ quiet'
RETURN

save_ibrowse:
  IF ~EXISTS(hotlist_ibrowse) THEN DO
    Requestnotify '"IBrowse hotlist not found!"' '"_OK"'
    RETURN
  END
  ELSE DO
    CALL OPEN(in,hotlist_ibrowse,'r')
    CALL OPEN(out,'t:IBrowse.tmp','w')
      line = READLN(in)
      DO UNTIL line = '<UL>'
        WRITELN(out, line)
        line = READLN(in)
      END
      WRITELN(out, line)
      DO i = 1 TO save.count
        IF savename.i = '' THEN savename.i = destvar.1 '('i')'
        adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
        WRITELN(out, adres)
      END
      DO UNTIL EOF(in)
        rest = readch(in,1048576) /* 1MB should be enough :.) */
        WRITECH(out, rest)
      END
    CALL CLOSE(out)
    CALL CLOSE(in)
    ADDRESS COMMAND 'copy t:ibrowse.tmp' hotlist_ibrowse 'quiet'
    ADDRESS COMMAND 'delete t:ibrowse.tmp quiet'
  END
RETURN

save_html:
  IF ~EXISTS(hotlist_html) THEN DO
    Requestnotify '"HTML hotlist not found!"' '"_OK"'
    RETURN
  END
  ELSE DO
    CALL OPEN(htlst,hotlist_html,'a')
    DO i = 1 TO save.count
      CALL WRITELN(htlst,'<LI><A HREF="'save.i'">'STRIP(name.i)'</A><br>')
    END
    CALL CLOSE(htlst)
  END
RETRUN

save_aweb:
  IF ~EXISTS(hotlist_aweb) THEN DO
    Requestnotify '"AWeb hotlist not found!"' '"_OK"'
    RETURN
  END
  ELSE DO
    CALL OPEN(htlst,hotlist_aweb,'a')
    DO i = 1 TO save.count
      CALL WRITELN(htlst,save.i)
      CALL WRITELN(htlst,STRIP(name.i))
    END
    CALL CLOSE(htlst)
  END
RETURN

save_Voyager:
  IF ~EXISTS(hotlist_voyager) THEN DO
    Requestnotify '"Voyager hotlist not found!"' '"_OK"'
    RETURN
  END
  ELSE DO
    CALL OPEN(in,hotlist_voyager,'r')
    CALL OPEN(out,'t:voyager.tmp','w')
      line = READLN(in)
      DO UNTIL line = '<UL>'
        WRITELN(out, line)
        line = READLN(in)
      END
      WRITELN(out, line)
      DO i = 1 TO save.count
        IF savename.i = '' THEN savename.i = destvar.1 '('i')'
        adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
        WRITELN(out, adres)
      END
      DO UNTIL EOF(in)
        rest = readch(in,1048576) /* 1MB should be enough :.) */
        WRITECH(out, rest)
      END
    CALL CLOSE(out)
    CALL CLOSE(in)
    ADDRESS COMMAND 'copy t:voyager.tmp' hotlist_voyager 'quiet'
    ADDRESS COMMAND 'delete t:voyager.tmp quiet'
  END
RETURN

/* end gethttp */

/* getemail */
get_email:
  SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI OVERWRITE
  IF(RC ~= 0) THEN DO
    'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
    EXIT
  END
  ELSE DO
    CALL getemail
    CALL listfound
    IF ok = 1 THEN CALL listsave(2)
  END
RETURN

getemail:
  CALL OPEN(tmp, tempfile, 'r')
    num = 0
    found.count = 0
    DO WHILE ~EOF(tmp)
      msg = READLN(tmp)
      PARSE VAR msg part1 '@' part2 '.' part3 rest
      DO FOREVER
        IF (part2 ~= '' & POS(' ',part2) = 0 & part3 ~= '') THEN DO
          spc = LASTPOS(' ', part1)
          IF spc ~= 0 THEN part1 = DELSTR(part1, 1, spc)
          lengte = LENGTH(part1)
          CALL filter(part1,lengte,2)
          part1 = RESULT
          lengte = LENGTH(part3)
          CALL FILTER(part3,lengte,1)
          part3 =  RESULT
          email = part1'@'part2'.'adres
          n = 0
          DO i = 1 TO found.count
            IF email ~= found.i THEN n = n +1
          END        
          IF n = found.count THEN DO
            num = num + 1
            found.num = email
            found.count = num
          END
        END
        IF POS('@', rest) ~= 0 THEN DO
          PARSE VAR rest part1 '@' part2 '.' part3 rest
          empty = 0
        END 
        ELSE empty = 1
        IF empty = 1 THEN LEAVE
      END
    END
  CALL CLOSE(tmp)
  ADDRESS COMMAND 'delete >nil:' tempfile
RETURN

userdata:
  IF alias.n = 'ALIAS.'n THEN alias.n = ''
  IF comm.n  = 'COMM.'n  THEN comm.n  = ''
  showdata.1 = 'name    :' name.n
  showdata.2 = 'address :' save.n
  showdata.3 = 'alias   :' alias.n
  showdata.4 = 'comment :' comm.n
  showdata.5 = ''
  showdata.6 = 'RETURN'
  showdata.count = 6
  titel = 'Userdata for' save.n
  REQUESTLIST INSTEM showdata TITLE '"'titel'"' SIZEGADGET
  IF (RC = 30) THEN DO
    REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
    EXIT
  END
  IF RC ~= 5 THEN DO
    sel = RESULT
    IF sel = showdata.1 THEN DO
      RESULT = name.n
      REQUESTSTRING TITLE '"Enter a name for"' BT '"_OK|_From:|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
      IF THORRC = 0 then name.n = ''
      IF THORRC = 1 then name.n = RESULT
      IF THORRC = 2 THEN name.n = fromname
    END
    IF sel = showdata.2 THEN DO
      RESULT = save.n
      REQUESTSTRING TITLE '"Change address"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'save.n'"'
      save.n = RESULT
    END
    IF sel = showdata.3 THEN DO
      RESULT = alias.n
      REQUESTSTRING TITLE '"Enter an alias for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'alias.n'"'
      alias.n = RESULT
    END
    IF sel = showdata.4 THEN DO
      RESULT = comm.n
      REQUESTSTRING TITLE '"Enter a comment for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'comm.n'"'
      comm.n = RESULT
    END
    IF sel = 'RETURN' THEN SIGNAL listsave(2)
    SIGNAL userdata
  END
  ELSE SIGNAL main
RETURN

save_userdata:
  DROP USER.
  DO i = 1 TO save.count
    IF name.i = '' THEN DO
      PARSE VAR save.i part1 '@'
      name.i = part1
    END
    USER.NAME      = name.i
    USER.ADDRESS   = save.i
    USER.ALIAS     = alias.i
    USER.COMMENT.1 = comm.i
    IF USER.COMMENT.1 = '' THEN USER.COMMENT.COUNT = 0
    ELSE USER.COMMENT.COUNT = 1
    ADDRESS BBSREAD WRITEBRUSER BBSNAME '"'bbs'"' STEM USER ONLYIFEXIST
    IF RC~=0 THEN DO
      REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
      CALL EXIT
    END
  END
  IF loop = 1 THEN SIGNAL main
RETURN
/* end getemail */

filter:
  PARSE ARG adres,lngth,fltr
  IF fltr = 2 THEN adres=REVERSE(adres)
  DO i = 1 TO filter.fltr.count
    check = POS(filter.fltr.i, adres)
    IF check ~=0 THEN adres = DELSTR(adres, check)
  END
  punt = LASTPOS('.', adres)
  IF punt ~=0 THEN lngth = length(adres)
  IF (punt = lngth) THEN adres = DELSTR(adres, punt)
  IF fltr = 2 THEN adres=REVERSE(adres)
RETURN(adres)

listfound:
  IF found.COUNT > 0 THEN DO
    REQUESTLIST INSTEM found OUTSTEM save TITLE '"Select address(es) to save"' MULTISELECT SIZEGADGET
    IF (RC = 30) THEN DO
      REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
      EXIT
    END
    IF RC ~= 5 THEN ok = 1
  END
  IF found.COUNT = 0 THEN DO
    REQUESTNOTIFY '"No addresses found in this message."' '"_Ok"'
    EXIT
  END
RETURN

listsave:
  PARSE ARG soort
    DO i = 1 TO save.count
      IF name.i = 'NAME.'i THEN name.i = ''
      showname.i = LEFT(name.i,20,' ')
      show.i = showname.i' - 'save.i
    END
    sep = save.count +1
    but = save.count +2
    show.sep = ''
    show.but = 'SAVE'
    show.count = save.count+2
  IF soort = 1 THEN titel = 'Select to enter a name'
  IF soort = 2 THEN titel = 'Select address to edit userdata'
  REQUESTLIST INSTEM show TITLE '"'titel'"' SIZEGADGET
  IF (RC = 30) THEN DO
    REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
    EXIT
  END
  IF RC ~= 5 THEN DO
    selected = RESULT
    IF selected = 'SAVE' THEN DO 
      IF soort = 1 THEN SIGNAL savehotlist
      IF soort = 2 THEN SIGNAL save_userdata
    END
    DO n = 1 TO save.count
      IF selected = show.n THEN DO
        IF soort = 1 THEN DO
          REQUESTSTRING title '"Enter a name"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
          name.n = RESULT
        END
        IF soort = 2 THEN SIGNAL userdata
      END
    END
    IF soort = 1 THEN SIGNAL listsave(1)
    IF soort = 2 THEN SIGNAL listsave(2)
  END
RETURN