Отправка письма на Perl через SMTP с аутентификацией и аттачем

22:33:00 21.11.2010 Комментарии: 0

При отправке писем через sendmail у ru-center (nic.ru) начали происходить какие-то странные вещи... самая не приятная из них - это, что при отправке одного маленького текстового письма может неожиданно закончится оперативная память. И ее не хватит, чтобы запустить sendmail. ...Служба поддержки как-то вяло на это все реагирует, поэтому выход только один - не использовать sendmail. Поэтому поводу, модуль Mail.pm, который подключается к серверу по smtp и поддерживает аутентификацию, и все это работает на nic.ru:


package Mail;
use Exporter;

@ISA = ('Exporter');

#@EXPORT=qw(&SendMail &GetLastSendMailError);
@EXPORT = qw();
use vars qw($Error_Message);

use strict;
use warnings;
use Net::SMTP;
use MIME::Base64;

sub GetLastSendMailError {
	$Error_Message;
}

sub SendMail {
	my $fuc   = shift;
	my $param = shift;
	$param->{smtp_server} ||= "mail.nic.ru";
	$param->{login}       ||= "";
	$param->{password}    ||= "";

	$fuc->Error( "Send mail from " . $param->{to} . " to " . $param->{from} )
	  unless ( $param->{to} && $param->{from} );

	my @files;
	@files = @{ $param->{files} } if ( ref $param->{files} eq "ARRAY" );

	my $msg = "MIME-Version: 1.0\r\n";

	my $mime_id = 'fuc-' . time;
	if ( !$files[0] ) {
		$msg .= "Content-Type: text/plain; charset=windows-1251\r\n";
		$msg .=
		    "From: "
		  . $param->{from} . "\r\n"
		  . "Subject: "
		  . $param->{subject}
		  . "\r\n\r\n";
		$msg .= $param->{body} . "\r\n" if ( $param->{body} and !$files[0] );

	}
	else {
		$msg .= "Content-Type: multipart/mixed; boundary=" . $mime_id . "\r\n";
		$msg .=
		    "From: "
		  . $param->{from} . "\r\n"
		  . "Subject: "
		  . $param->{subject}
		  . "\r\n\r\n";

		if ( $param->{body} ) {
			$msg .=
			    "--$mime_id\r\n"
			  . "Content-Type: text/plain; charset=windows-1251\r\n"
			  . "Content-Transfer-Encoding: quoted-printable\r\n\r\n"
			  . $param->{body}
			  . "\r\n\r\n";
		}

		for ( my $i = 0 ; $i < ( 1 + $#files ) ; $i++ ) {
			next unless ( $files[$i] );

			my $attach_file = $files[0];

			#   $attach_file =~ /[\\\/:]([^\\\/:]+)$/g;
			$attach_file =~ /.*(\.[^.]*)/;
			my $filename = "attach" . $1;

			$msg .=
			    "--$mime_id\r\n"
			  . "Content-Type: application/octet-stream; name=$filename\r\n"
			  . "Content-Transfer-Encoding: base64\r\n"
			  . "Content-Disposition: attachment; filename=$filename\r\n";

			local $/;
			seek $attach_file, 0, 0;
			my $cont = <$attach_file>;

			my $base64_encoded_data = encode_base64($cont);
			if ( !$base64_encoded_data ) { return (11) }

			$msg .= "\r\n" . $base64_encoded_data . "--$mime_id--\r\n\r\n";

		}
	}

	my $smtp = Net::SMTP->new( $param->{smtpserver}, Timeout => 60) #, Debug => 1 
	  or $fuc->Error("Cannot connect to smtp server");

	$smtp->auth( $param->{login}, $param->{password} )
	  if ( $param->{login} && $param->{password} );
	$smtp->mail( $param->{from} );
	$smtp->to( $param->{to} );
	$smtp->data();
	$smtp->datasend($msg);
	$smtp->dataend();
	$smtp->quit;

}

1;
=pod

=head1 NAME 

Mail.pm

=head1 DESCRIPTION

Отправляет почту через smtp-сервер, поддерживает аутентификацию через md5 хэш. Отправляет файлы. Текст письма отправляется в windows-1251.

	Mail::SendMail(
		{
			smtpserver => "smtp.testmail.com",
			login => "login",
			password => "password",
			subject => "creograf.ru",
			from => "email@from.ru",
			to   => "email@to.ru",
			body => "test mail",
			files => [$testfilehandle],
		}
        )

 
=head1 COPYRIGHT

Деева А.С., Студия "Креограф" L<http://creograf.ru>, L<support@creograf.ru>

=cut

Отправка письма на Perl через SMTP с аутентификацией и аттачем