sendmail.pm

绿叶网络小学校园网-完全适合小学的网站

#
# METHOD:	$obj->createMailData();
#
# DESCRIPTION:	This method will create the mail data which will be sent to the
#		SMTP server. It will contain some mail headers and mail body.
#
#===============================================================================
sub createMailData () {
    my($self) = shift;
    my($currHeader) = undef;

    return -1 if $self->isMailReady() != 0;

    $self->{'maildata'} = undef;

    $self->{'maildata'} = "To: ";
    $self->{'maildata'} .= join(",\r\n\t", @{$self->{'mailheaders'}->{'TO'}});
    $self->{'maildata'} .= "\r\nFrom: ".$self->{'mailheaders'}->{'FROM'}."\r\n";
    $self->{'maildata'} .= "Subject: ".$self->{'mailheaders'}->{'SUBJECT'}."\r\n";
    if (defined $self->{'mailheaders'}->{'CC'} && 
		@{$self->{'mailheaders'}->{'CC'}} > 0) {
      $self->{'maildata'} .= "Cc: ";
      $self->{'maildata'} .= join(",\r\n\t", @{$self->{'mailheaders'}->{'CC'}});
      $self->{'maildata'} .= "\r\n";
    }

    if (defined $self->{'mailheaders'}->{'REPLY-TO'} && 
		@{$self->{'mailheaders'}->{'REPLY-TO'}} > 0) {
      $self->{'maildata'} .= "Reply-To: ";
      $self->{'maildata'} .= join(",\r\n\t", 
		@{$self->{'mailheaders'}->{'REPLY-TO'}})."\r\n";
    }

    if (defined $self->{'mailheaders'}->{'ERRORS-TO'} && 
		@{$self->{'mailheaders'}->{'ERRORS-TO'}} > 0) {
      $self->{'maildata'} .= "Errors-To: ";
      $self->{'maildata'} .= join(",\r\n\t", 
		@{$self->{'mailheaders'}->{'ERRORS-TO'}})."\r\n";
    }

    for $currHeader (sort keys %{$self->{'mailheaders'}->{'OTHERS'}}) {
      my($currMailHeader) = undef;
      ($currMailHeader = $currHeader) =~ s/\b(\w)(\w+)\b/$1\L$2/g;
      $self->{'maildata'} .= "$currMailHeader: ";
      $self->{'maildata'} .= $self->{'mailheaders'}->{'OTHERS'}->{$currHeader};
      $self->{'maildata'} .= "\r\n";
    }

    if (scalar(@{$self->{'attachmentArr'}}) > 0) {
      my($currHash);
      srand(time ^ $$);
      my($boundary) = "==__SENDMAIL__".
		join("", ('a'..'z','A'..'Z', 0..9)[map rand $_, (62)x25]).
		"__==";
      $self->{'maildata'} .= "MIME-Version: 1.0\r\n";
      $self->{'maildata'} .= "Content-Type: multipart/mixed; ";
      $self->{'maildata'} .= "boundary=\"$boundary\"\r\n";
      $self->{'maildata'} .= "\r\n";

      if (defined $self->{'mailbody'}) {
        $self->{'maildata'} .= "\-\-$boundary\r\n";
        $self->{'maildata'} .= "Content-Type: text/plain; charset=\"iso-8859-1\"\r\n";
        $self->{'maildata'} .= "Content-Transfer-Encoding: quoted-printable\r\n\r\n";
        $self->{'maildata'} .= encode_qp($self->{'mailbody'})."\r\n\r\n";
      }

      for $currHash (@{$self->{'attachmentArr'}}) {
        $currHash->{'content-type'} = 
		$self->getMIMEType($currHash->{'filename'});
        $self->{'maildata'} .= "\-\-$boundary\r\n";
        $self->{'maildata'} .= "Content-Type: $currHash->{'content-type'}; name=\"$currHash->{'filename'}\"\r\n";
        $self->{'maildata'} .= "Content-Transfer-Encoding: base64\r\n";
        $self->{'maildata'} .= "Content-Disposition: $currHash->{'attachtype'}; filename=\"$currHash->{'filename'}\"\r\n";
        $self->{'maildata'} .= "\r\n";

	if (defined $currHash->{'dataref'}) {
	  if (ref($currHash->{'dataref'}) eq "SCALAR") {
	    $self->{'maildata'} .= encode_base64(${$currHash->{'dataref'}}, "\r\n");
	  }
	  else {
	    my($data) = undef;
	    my($buff) = "";
	    my($pos) = 0;
	    (defined ($pos = tell($currHash->{'dataref'}))) ||
    		return $self->setError("Error in tell(): $!");
	    while (read($currHash->{'dataref'}, $buff, 1024)) {
	      $data .= $buff;
            }
	    $self->{'maildata'} .= encode_base64($data, "\r\n");
	    seek($currHash->{'dataref'}, $pos, 0) ||
    		return $self->setError("Error in seek(): $!");
	  }
	}
	elsif (-f $currHash->{'filepath'}) {
          my($data) = undef;
	  my($buff) = "";
          open(FILE, $currHash->{'filepath'});
	  # In Windows platform, non-text file should use binmode() function.
	  if (! -T $currHash->{'filepath'}) {
	    binmode(FILE);
	  }
	  while (sysread(FILE, $buff, 1024)) {
	    $data .= $buff;
          }
          close(FILE);
          $self->{'maildata'} .= encode_base64($data, "\r\n");
	}
	else {
	  $self->{'maildata'} .= encode_base64("", "\r\n");
	}
        $self->{'maildata'} .= "\r\n";
      }
      $self->{'maildata'} .= "\-\-${boundary}\-\-\r\n";
    }
    else {
      $self->{'maildata'} .= "\r\n";
      $self->{'maildata'} .= "$self->{'mailbody'}\r\n";
    }

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->getEmailAddress($emailaddstr);
#
# DESCRIPTION:	Get the email address from the email address string which might
#		contain email account owner's name, what we want is the email 
#		address only.
#
#===============================================================================
sub getEmailAddress ($) {
    my($self)  = shift;
    my($value) = shift;
    my($retvalue) = undef;

    if ($value =~ /^\<([^\>\@]+\@[\w\-]+(\.[\w\-]+)+)\>/) {
      ($retvalue = $1) =~ tr/[A-Z]/[a-z]/;
      return $retvalue;
    }

    if ($value =~ /^[^\<]+\<([^\>\@]+\@[\w\-]+(\.[\w\-]+)+)\>/) {
      ($retvalue = $1) =~ tr/[A-Z]/[a-z]/;
      return $retvalue;
    }

    return "" if $value =~ /\s+/;

    $value =~ tr/[A-Z]/[a-z]/;
    return $value if $value =~ /^[^\@]+\@[\w\-]+(\.[\w\-]+)+$/;

    return "";
}

#===============================================================================
#
# METHOD:	$obj->getMIMEType($filename);
#
# DESCRIPTION:	This will return MIME type for $filename.
#
#===============================================================================
sub getMIMEType ($) {
    my($self) = shift;
    my($filename) = shift;
    my($ext, %MIMEHash);

    %MIMEHash = (
	'au'	=> 'audio/basic',
	'avi'	=> 'video/x-msvideo',
	'class'	=> 'application/octet-stream',
	'cpt'	=> 'application/mac-compactpro',
	'dcr'	=> 'application/x-director',
	'dir'	=> 'application/x-director',
	'doc'	=> 'application/msword',
	'exe'	=> 'application/octet-stream',
	'gif'	=> 'image/gif',
	'gtx'	=> 'application/x-gentrix',
	'jpeg'	=> 'image/jpeg',
	'jpg'	=> 'image/jpeg',
	'js'	=> 'application/x-javascript',
	'hqx'	=> 'application/mac-binhex40',
	'htm'	=> 'text/html',
	'html'	=> 'text/html',
	'mid'	=> 'audio/midi',
	'midi'	=> 'audio/midi',
	'mov'	=> 'video/quicktime',
	'mp2'	=> 'audio/mpeg',
	'mp3'	=> 'audio/mpeg',
	'mpeg'	=> 'video/mpeg',
	'mpg'	=> 'video/mpeg',
	'pdf'	=> 'application/pdf',
	'pm'	=> 'text/plain',
	'pl'	=> 'text/plain',
	'ppt'	=> 'application/powerpoint',
	'ps'	=> 'application/postscript',
	'qt'	=> 'video/quicktime',
	'ram'	=> 'audio/x-pn-realaudio',
	'rtf'	=> 'application/rtf',
	'tar'	=> 'application/x-tar',
	'tif'	=> 'image/tiff',
	'tiff'	=> 'image/tiff',
	'txt'	=> 'text/plain',
	'wav'	=> 'audio/x-wav',
	'xbm'	=> 'image/x-xbitmap',
	'zip'	=> 'application/zip',
    );
    ($ext) = $filename =~ /\.([^\.]+)$/;
    $ext =~ tr/[A-Z]/[a-z]/;
    
    return defined $MIMEHash{$ext} ? $MIMEHash{$ext} : "application/octet-stream";

}

#===============================================================================
#
# METHOD:	$obj->getRcptLists();
#
# DESCRIPTION:	This will generate an array of the recipients' email address.
#		Basically, this method only called by $obj->sendMail() method, 
#		which needs to send "RCPT TO:" request to the SMTP server.
#
#===============================================================================
sub getRcptLists () {
    my($self) = shift;
    my(@rcptLists) = ();
    my($currEmail) = undef;

    for $currEmail (@{$self->{'mailheaders'}->{'TO'}}) {
      my($currEmail) = $self->getEmailAddress($currEmail);
      push(@rcptLists, $currEmail) if 
		($currEmail !~ /^\s*$/ && (! grep(/^$currEmail$/, @rcptLists)));
    }

    if (defined $self->{'mailheaders'}->{'BCC'} && 
		@{$self->{'mailheaders'}->{'BCC'}} > 0) {
      for $currEmail (@{$self->{'mailheaders'}->{'BCC'}}) {
        my($currEmail) = $self->getEmailAddress($currEmail);
        push(@rcptLists, $currEmail) if 
		($currEmail !~ /^\s*$/ && (! grep(/^$currEmail$/, @rcptLists)));
      }
    }

    if (defined $self->{'mailheaders'}->{'CC'} && 
		@{$self->{'mailheaders'}->{'CC'}} > 0) {
      for $currEmail (@{$self->{'mailheaders'}->{'CC'}}) {
        my($currEmail) = $self->getEmailAddress($currEmail);
        push(@rcptLists, $currEmail) if 
		($currEmail !~ /^\s*$/ && (! grep(/^$currEmail$/, @rcptLists)));
      }
    }

    return \@rcptLists;
}

#===============================================================================
#
# METHOD:	$obj->isMailReady();
#
# DESCRIPTION:	Check if the basic mail headers and the mail body have been set 
#		or not.
#		p/s: The "From:", "To:" and "Subject:" mail headers are required
#		here, I feel that a mail should contain these headers. It is 
#		just a personal opinion, if you do not think so, just comment 
#		them out.
#
#===============================================================================
sub isMailReady () {
    my($self) = shift;

    return $self->setError("发信人没有填写.<br>No sender has been specified.") if
	! defined $self->{'mailheaders'}->{'FROM'};

    return $self->setError("收信人没有指定.<br>No recipient has been specified.") if 
	((! defined $self->{'mailheaders'}->{'TO'}) ||
		(defined @{$self->{'mailheaders'}->{'TO'}} &&
		 @{$self->{'mailheaders'}->{'TO'}} < 1));

    return $self->setError("邮件主题没有.<br>No subject has been specified.") if
	! defined $self->{'mailheaders'}->{'SUBJECT'};

    return $self->setError("邮件正文没有填写.<br>No mail body has been set.") if
	((! defined $self->{'mailbody'}) &&
		(scalar(@{$self->{'attachmentArr'}}) < 1));

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->receiveFromServer(\*SOCKET);
#
# DESCRIPTION:	This will receive the data replied from the server.
#
#===============================================================================
sub receiveFromServer ($) {
    my($self) = shift;
    my($socket) = shift;
    my($reply);

    #
    # We keep receiveing the data from the server until
    # it waits for next command.
    #
    while ($socket && ($reply = <$socket>)) {
      return $self->setError($reply) if $reply =~ /^5/;
      print $reply if $self->{'debugmode'};
      last if $reply =~ /^\d+ /;
    }

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->reset();
#
# DESCRIPTION:	This will clear the data that have been set before.
#
#===============================================================================
sub reset () {
    my($self) = shift;

    $self->{'debugmode'} = $self->OFF;
    $self->{'mailbody'} = undef;
    $self->{'maildata'} = undef;
    $self->{'mailheaders'} = undef;
    $self->{'sender'} = undef;
    $self->{'attachmentArr'} = [];

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->sendMail();
#
# DESCRIPTION:	This will use the Socket to connect to the SMTP port to send the#		mail.
#
#===============================================================================
sub sendMail () {
    my($self) = shift;
    my($iaddr, $paddr, $proto, $rcptlistRef, $currEmail) = undef;

    #
    # Get the sender's email address, this will be used in "MAIL FROM:" request.
    #
    $self->{'sender'} = $self->getEmailAddress($self->{'mailheaders'}->{'FROM'});

    #
    # Invalid email address format.
    #
    return $self->setError("Please check the sender's email address setting.")
	if $self->{'sender'} =~ /^\s*$/; 

    #
    # We create the mail data here.
    #
    return -1 if $self->createMailData() != 0;

    #
    # We get the recipients' email addresses.