/*          To create an .ASC file from the Reply-to:, From:, or          */
/*                 Sender: line of each note in a folder                  */
/*                      Parameters: folder_directory                      */
/*    InnoVal Systems Solutions, Inc., and the authors cannot be held     */
/*   responsible for damage that might occur while using this program.    */
/*                         Use at your own risk.                          */

call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
signal on syntax name NoRexx
call SysLoadFuncs
signal on syntax name Syntax
'@ECHO OFF'
parse arg directory
if directory='' then do
   say ""
   say "Creates .ASC file (from which ASC2ADR.CMD can create a Post Road Mailer"
   say "address book file) from the Reply-to: or From: line of every note in a"
   say "folder.  Specify the pathname of the folder as a command line parameter."
   say ""
   exit
end
outfile=systempfilename('PRMBK???.ASC')
Call LineOut outfile, 'Addresses from' directory 'folder (Post Road Mailer address book)'
Call LineOut outfile, 'The fields are:'
Call LineOut outfile, 'Last Name<tab>First Name<tab>Organization<tab>Email 1<tab>Nickname 1<tab>....Email 5<tab>Nickname 5<tab>Telephone 1<tab>Telephone 2<tab>Fax<tab>Notes 1<tab>Notes 2<tab>Notes 3<tab>....Notes X'
call lineout outfile,''
call sysfiletree directory'\*.POP',files,'FO'
addresses.0=0
do i=1 to files.0
   drop from reply sender
   do while lines(files.i)
      line=linein(files.i)
      if strip(line)='' then leave
      parse var line tag ' ' value
      tag=translate(tag)
      if tag='FROM:' then FROM=value
      if tag='REPLY-TO:' then REPLY=value
      if tag='SENDER:' then SENDER=value
   end
   call lineout files.i
   select
      when REPLY<>'REPLY' then call entry REPLY
      when FROM<>'FROM' then call entry FROM
      when SENDER<>'SENDER' then call entry SENDER
      otherwise nop
   end
end
say ""
say "The folder's addresses have been exported to file" outfile
say "There were" addresses.0 "unique addresses."
say ""
exit
entry:procedure expose outfile addresses.
   parse arg address
   address=translate(address,' ','"')
   last='' ; first='' ; email='' ; name='' ; check=''
   select
      when pos('<',address)>0 then parse var address name '<' email '>' .
      when pos('(',address)>0 then parse var address email '(' name ')' .
      otherwise email=address
   end
   name=strip(name)
   if name<>'' then do
      if pos(',',name)>0 then do
         parse var name last ',' first
         first=strip(first)
         check=translate(first)
         if check='JR.' | check='SR.' | check='JR' | check='SR' | check='' then do
            lastspace=lastpos(' ',last)
            check=first
            parse var last first =(lastspace) last
            last=last check
         end
      end
      else do
         lastspace=lastpos(' ',name)
         parse var name first =(lastspace) last
      end
   end
   email=strip(email)
   last=strip(last)
   first=strip(first)
   if last='' then last=first
   if last='' /* still, which would mean that FIRST='' also */ then last='Unknown'
   if first=last then first=''
   if words(EMAIL)=1 then do
      match=0
      do j=1 to addresses.0
         if email=addresses.j then match=1
      end
      if match then return
      addresses.0=addresses.0+1
      j=addresses.0
      addresses.j=email
      call lineout outfile,LAST||'09'x||FIRST||'09'x||'09'x||EMAIL||copies('09'x,13)
   end
return
Syntax:
  say 'Error' rc 'in line' sigl':' errortext(rc)
  say sigl':' sourceline(sigl)
  exit
return
NoRexx:
   say 'Unable to load the REXXUtil functions.  Either the REXXUTIL.DLL file'
   say 'is not on the LIBPATH or REXX support is not installed on this system.'
   exit
return
