[inherit('sys$library:starlet','lib$spawn','smgdefs','smg$repaint_line',
'BB.PEN')]
module put_internet;

[global] 
procedure put_internet(mail_file:string);

{Spawn a mail process to mail a message to the poster of a message or
 to the internet readers of the current topic}

var
  mail_command : string;
  recipient : string;
  stat : integer;
  subject : string;

begin
  close(ifile,disposition:=save,error:=continue);

  subject := current_record.subject;
  i := length(subject)+1;
  repeat
    i := i - 1;
  until (subject[i] <> ' ') or (i = 1);
  if (subject[i] = ' ') then
    subject := ''    
  else
    subject := substr(subject,1,i);
  subject := '"'+subject+'"';

  if (destination_option = 'P') then
    begin
      write_menu('','Sending message to poster...');
      recipient := dir_curr^.poster;
    end
  else
    begin
      write_menu('','Adding message to internet bulletin board...');
      findk(bbfile,0,null_date+current_topic,eql,error:=continue);  
      if not ufb(bbfile) then
        begin
          read(bbfile,current_record,error:=continue);        
          if (status(bbfile) < 1) then recipient := current_record.poster;
        end;
    end;

  {Build address for recipient.  If sending to internet BB, address will
   be extracted from the data base file.  If sending to the poster, the
   address is extracted from the message replied to.  The following code
   builds the mail command to spawn the mail job and uses the MAILER!
   format to send the message.}
  i := length(recipient) + 1;
  repeat
    i := i - 1;
  until (recipient[i] <> ' ') or (i = 1);

  if recipient[i] = ' ' then
    recipient := ''    
  else
    recipient := substr(recipient,1,i);

  if (length(recipient) = 0) then
    write_error('Destination address unknown.')
  else
    begin
      if (index(recipient,'::') = 0) then
        recipient := '"MAILER!<'+recipient+'>"';
      mail_command := 'mail/subject='+subject+' '+mail_file+' '+recipient;
      stat :=lib$spawn(command_string:=mail_command,input_file:='_NLA0:',
                       flags:=1);
      if (stat <> ss$_normal) then write_error('Cannot send message.');
    end;
end;

end.
