/*
 $VER: GetEmail.Thor 1.3 by Remco van Hooff

 Rips email addresses out of the current message, and
 optionaly saves them to the userlist of your Email system.

------------------------- HISTORY -------------------------
1.0 - First release
1.1 - Some little cosmetic fixes
1.2 - Fixed a parsing bug, now addresses at the beginning
      of a line are parsed ok.
1.3 - Added checking if there is more than one address on
      one a line, so all addresses should be found now.
------------------------- CREDITS -------------------------
Jon Ward, for the idea.
-----------------------------------------------------------
*/

bbs       = 'Email'        /* your Email system */

/*trace results*/ /*for debugging*/

if ~show('l','rexxreqtools.library') then call addlib('rexxreqtools.library',0,-30,0)
if ~show('l','rexxsuppport.library') then call addlib('rexxsupport.library',0,-30,0)

drop USER.
tempfile  = 't:email.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

'GETGLOBALCONFIG GC'
thorscreen =GC.PUBSCREENNAME

saved = 0
if exists(tempfile) then call delete(tempfile)
SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI
if(rc ~= 0) then do
  'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  exit
end

else do
  call open(tmp,tempfile,'r')
  msg = readch(tmp,102400)
  check = pos('@', msg)
    if check = 0 then do
      'requestnotify text "No Email address found." bt "_OK"'
      signal abort
    end
  call close(tmp)  
  if check ~= 0 then do
    call open(tmp, tempfile, 'r')
      do while ~eof(tmp)
        msg = readln(tmp)
        parse var msg part1 '@' part2 '.' part3 rest
        do forever
          if part2 ~= '' then do
            spc = lastpos(' ', part1)
            if spc ~= 0 then part1 = delstr(part1, 1, spc)
            lengte = length(part3)   
            call filter(part3, lengte)
            vraag = center(' Add this Email address? ',lengte2,'-')
            if lengte2 < 23 then vraag = 'Add this Email address?'
            email = rtgetstring(email,vraag,'GetEmail','_Add|_Quit|_Skip','rt_pubscrname='thorscreen)
            if rtresult = 1 then do
              call ask
            end
            if rtresult = 2 then do
              signal abort
            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)
  end
  call delete(tempfile)
  'requestnotify text "No more Email addresses found." bt "_OK"'
end
exit

ask:
  address(thorport)
  do forever
    REQUESTSTRING title '"GetEmail"' BT '"_Ok|_Cancel"' body '"Enter owner of the address\n'email'."' ID '"'part1'"'
    if rc=30 then do
	REQUESTNOTIFY '"'THOR.LASTERROR'"' '"_Ok"'
	call abort
    end
    username = result
    if rc = 0  then leave
  end

  'REQUESTSTRING title "GetEmail" body "Enter an alias for\n'username':" BT "_Ok|_Cancel" MAXCHARS=100'
   if rc = 0 then useralias = result
   if rc = 5 then useralias = ''
  'REQUESTSTRING title "GetEmail" body "Enter a comment:" BT "_Ok|_Cancel" MAXCHARS=100'
  if rc = 0 then usercomment = result
  if rc = 5 then usercomment = ''
  'REQUESTNOTIFY "Name : 'username'\nAddr : 'email'\nAlias: 'useralias'\nComnt: 'usercomment'\n\nAdd this user to system' bbs'?"' '"_Yes|_No"'
  if rc~=0 then do
    REQUESTNOTIFY '"THOR.LASTERROR"' '"_Ok"'
    call abort
  end
  if result ~= 0 then do
    address BBSREAD
    USER.NAME      = username
    USER.ADDRESS   = email
    USER.ALIAS     = useralias
    USER.COMMENT.1 = usercomment
    if USER.COMMENT.1 = '' then USER.COMMENT.COUNT = 0; else USER.COMMENT.COUNT = 1

    WRITEBRUSER bbsname '"'bbs'"' stem USER ONLYIFEXIST
    if rc~=0 then do
      address(thorport)
      REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
      call abort
    end
end
return

filter:
  adres = arg(1)
  lngth = arg(2)
  lf    = '0a'x

  lnfd = pos(lf, adres)
  if lnfd ~=0 then do
    adres = delstr(adres, lnfd)
  end

  haak = lastpos(')', adres)
  if haak ~=0 then do
    adres =  delstr(adres, haak)
  end

  hook = lastpos('>', adres)
  if hook ~=0 then do
    adres =  delstr(adres, hook)
  end

  komma = pos(',', adres)
  if komma ~= 0 then do
    adres = delstr(adres, komma)
  end
  
  quote = pos("'", adres)
  if quote ~= 0 then do
    adres = delstr(adres, quote)
  end

  dquote = pos('"', adres)
  if dquote ~= 0 then do
    adres = delstr(adres, dquote)
  end

  email = part1'@'part2'.'adres
  lengte2 = length(email)
return

abort:
  call close(tmp)
  call delete(tempfile)
exit