sendmail.pm

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

    #
    $rcptlistRef = $self->getRcptLists();

    #
    # If no recipient has been specified, this is an error.
    #
    return $self->setError("No recipient has been specified.") if 
		@{$rcptlistRef} == 0;

    #
    # Please refer to Socket module manual. (perldoc Socket)
    #
    $iaddr = inet_aton($self->{'smtpserver'}) || 
		return $self->setError("no host: $self->{'smtpserver'}");
    $paddr = sockaddr_in($self->{'smtpport'}, $iaddr);
    $proto = getprotobyname('tcp');
    socket(SOCK, PF_INET, SOCK_STREAM, $proto) || 
		return $self->setError("Socket error: $!");
    connect(SOCK, $paddr) || 
	return $self->setError("Error in connecting to $self->{'smtpserver'} at port $self->{'smtpport'}: $!");

    return -1 if $self->receiveFromServer(\*SOCK) != 0;
    return -1 if $self->sendToServer(\*SOCK, "HELO $_LOCALHOST") != 0;
    return -1 if $self->receiveFromServer(\*SOCK) != 0;
    return -1 if $self->sendToServer(\*SOCK, "MAIL FROM: <$self->{'sender'}>") != 0;
    return -1 if $self->receiveFromServer(\*SOCK) != 0;
    for $currEmail (@{$rcptlistRef}) {
      return -1 if $self->sendToServer(\*SOCK, "RCPT TO: <$currEmail>") != 0;
      return -1 if $self->receiveFromServer(\*SOCK) != 0;
    }
    return -1 if $self->sendToServer(\*SOCK, "DATA") != 0;
    return -1 if $self->receiveFromServer(\*SOCK) != 0;
    return -1 if $self->sendToServer(\*SOCK, "$self->{'maildata'}\r\n.") != 0;
    return -1 if $self->receiveFromServer(\*SOCK) != 0;
    return -1 if $self->sendToServer(\*SOCK, "QUIT") != 0;
    return -1 if $self->receiveFromServer(\*SOCK) != 0;
    eof(SOCK) || close(SOCK) || 
	return $self->setError("Fail close connectiong socket: $!");
    print "The mail has been sent to ".scalar(@{$rcptlistRef}) if 
		$self->{'debugmode'};
    print " person/s successfully.\n" if $self->{'debugmode'};

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->sendToServer(\*SOCKET, $message);
#
# DESCRIPTION:	This will send the message to the SMTP server.
#
#===============================================================================
sub sendToServer ($$) {
    my($self) = shift;
    my($socket) = shift;
    my($message) = shift;

    print "$message\n" if $self->{'debugmode'};

    #
    # Sending data to the server.
    #
    send($socket, "$message\r\n", 0) || 
		return $self->setError("Fail to send $message: $!");

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->setDebug($obj->ON);
#		$obj->setDebug($obj->OFF);
#
# DESCRIPTION:	Set the debug mode as ON/OFF.
#		Also see: $obj->ON and $obj->OFF methods.
#
#===============================================================================
sub setDebug ($) {
    my($self) = shift;

    $self->{'debugmode'} = shift;

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->setError($errormessage);
#
# DESCRIPTION:	This will set the error message to "error" attribute in the 
#		object and return -1 value.
#
#===============================================================================
sub setError ($) {
    my($self)     = shift;
    my($errorMsg) = shift;

    $self->{'error'} = $errorMsg if $errorMsg !~ /^\s*$/;

    return -1;
}

#===============================================================================
#
# METHOD:	$obj->setMailBody($mailbody);
#
# DESCRIPTION:	Set the mail body content.
#
#===============================================================================
sub setMailBody ($) {
    my($self)	  = shift;
    my($mailbody) = shift;

    $self->{'mailbody'} = $mailbody;

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->setMailHeader($mailheader, $mailheadervalue);
#
# DESCRIPTION:	This method is used for setting custom email headers.
#
#===============================================================================
sub setMailHeader ($$) {
    my($self)	  	 = shift;
    my($mailheader)	 = shift;
    my($mailheadervalue) = shift;

    $mailheader =~ tr/[a-z]/[A-Z]/;

    $self->{'mailheaders'}->{'OTHERS'}->{$mailheader} = $mailheadervalue;

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->setSMTPPort($smtpport);
#
# DESCRIPTION:	Set the SMTP port.
#
#===============================================================================
sub setSMTPPort ($) {
    my($self)     = shift;
    my($smtpport) = shift;

    $self->{'smtpport'} = $smtpport if $smtpport =~ /^\d+$/;

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->setSMTPServer($smtpserver);
#
# DESCRIPTION:	Set the SMTP server.
#
#===============================================================================
sub setSMTPServer ($) {
    my($self)       = shift;
    my($smtpserver) = shift;

    $smtpserver =~ s/\s*//g;

    $self->{'smtpserver'} = $smtpserver if $smtpserver !~ /^\s*$/;

    return 0;
}

#===============================================================================
#
# METHOD:	$obj->version;
#
# DESCRIPTION:	Get the version of the module.
#
#===============================================================================
sub version () {
    my($self) = shift;

    return $VERSION;
}

#===============================================================================
#
# END of the module.
#
#===============================================================================
1;
__END__

=head1 NAME

SendMail -- This is a perl module which is using Socket to connect the SMTP port to send mails.

=head1 SYNOPSIS

  use SendMail;

  $smtpserver 		= "mail.server.com";
  $smtpport   		= 25;
  $sender     		= "Sender <[e-mail]>";
  $subject    		= "Subject of the mail.";
  $recipient  		= "Recipient <[e-mail]>";
  $recipient2 		= "Recipient 2 <[e-mail]>";
  @recipients 		= ($recipient, $recipient2);
  $administrator 	= "Administrator <[e-mail]>";
  $administrator2 	= "Administrator 2 <[e-mail]>";
  $replyto		= $sender;
  $replyto2		= $recipient;
  @replytos		= ($replyto, $replyto2);
  $header		= "X-Mailer";
  $headervalue		= "Perl SendMail Module 2.03";
  $mailbodydata		= "This is a testing mail.";

  $obj = new SendMail();
  $obj = new SendMail($smtpserver);
  $obj = new SendMail($smtpserver, $smtpport);

  $obj->setDebug($obj->ON);
  $obj->setDebug($obj->OFF);

  $obj->From($sender);

  $obj->Subject($subject);

  $obj->To($recipient);
  $obj->To($recipient, $recipient2);
  $obj->To(@recipients);

  $obj->Cc($recipient);
  $obj->Cc($recipient, $recipient2);
  $obj->Cc(@recipients);

  $obj->Bcc($recipient);
  $obj->Bcc($recipient, $recipient2);
  $obj->Bcc(@recipients);

  $obj->ErrorsTo($administrator);
  $obj->ErrorsTo($administrator, $administrator2);
  $obj->ErrorsTo(@administrators);

  $obj->ReplyTo($replyto);
  $obj->ReplyTo($replyto, $replyto2);
  $obj->ReplyTo(@replytos);

  $obj->setMailHeader($header, $headervalue);

  $obj->setMailBody($mailbodydata);

  $obj->Attach($file);
  $obj->Attach($file, \$filedata);
  $obj->Attach($file, \*FILEHANDLE);

  $obj->Inline($file);
  $obj->Inline($file, \$filedata);
  $obj->Inline($file, \*FILEHANDLE);

  if ($obj->sendMail() != 0) {
    print $obj->{'error'}."\n";
  }

  $obj->reset();

=head1 EXAMPLE


http://www.tneoh.zoneit.com/perl/SendMail/testSendMail.pl

=head1 DESCRIPTION


This module is written so that user can easily use it to send mailing list. 
Please do not abuse it.

And it can be used in any perl script to send a mail similar to sending mail
by using /usr/lib/sendmail program.

I have tested this module on Unix and Windows platforms, it works fine. 
Of course you need perl version 5. With the example script, 
testSendMail.pl, you can simply a testing on it.

Errors, comments or questions are welcome.

=head1 CHANGES


1.00->1.01 Recipients with email address contains a "-" in the hostname,
will be able to receive the email now.

1.01->1.02 Module now not only expecting one line reply from the server, it
can receive multiple lines until the server waiting for next command.

1.02->1.03 Repeat declaration of "$currEmail" will give an error in NT
system.

1.03->1.04 Email addresses are enclosed in < and > after "MAIL FROM" and
"RCPT TO" commands.(RFC821) For Microsoft Exchange 4, email addresses
not enclosed in < and > will get an error from the system.

1.04->1.05 getEmailAddress() subroutine should accept email address
in just "<[e-mail]>" format.

1.05->2.00b Simple MIME supported. attach(), Attach() and Inline() 
subroutines added.

2.00b->2.00 Attach() and Inline() supports for filehandle which is
easier for users who are using CGI.pm. Prototypes are added. And we
send "\r\n" to the SMTP server instead of only "\n".

2.00->2.01 After sending the maildata, supposed to be "\r\n" instead
of just "\n".

2.01->2.02 Calling eof() to check the opened socket, else it will
cause an error in ActivePerl5.6.

2.02->2.03 Change all EOL to "\r\n", instead of just "\n".

=head1 CREDITS


laurens van alphen

Dag 豬en

Juliano, Sylvia, CON, OASD(HA)/TMA

Tony Simopoulos

Jeff Graves

Pisciotta, Steve

=head1 SOURCE


http://www.tneoh.zoneit.com/perl/SendMail/SendMail.pm


=head1 AUTHOR


Simon Tneoh Chee-Boon	[e-mail]

Copyright (c) 1998,1999,2000 Simon Tneoh Chee-Boon. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 VERSION

Version 2.03 	16 August 2000

=head1 SEE ALSO

Socket.pm, MIME::Base64.pm, MIME::QuotedPrint.pm

=cut