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

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

Вот модуль, который отправляет письма через SMTP сервер с аутентификацией. Можно прикреплять файлы и передавать текст в юникоде.

Это продолжение поста Отправка письма на Perl через SMTP с аутентификацией и аттачем.

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 $encoding = $fuc->GetParam('Encoding');
    my $encoding = $fuc->GetParam( 'General', 'Encoding' );

	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=$encoding\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=$encoding\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";

		}
	}

    utf8::encode($msg) if($encoding =~/utf/i);
	my $smtp = Net::SMTP->new( $param->{smtpserver}, Timeout => 120) #, Debug => 1 
	  or die "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();
	#utf8
    while ( $msg =~ m/([^\r\n]*)(\r\n|\n\r|\r|\n)?/g ) {
        my $line = ( defined($1) ? $1 : "" ) . "\r\n";
        $smtp->datasend( $line );
    }
    $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, L

=cut

Похожие записи

• Запуск web-сервера из командной строки
• Настройка Macbook'a для web-разработки на perl'e
• Полезный код на perl'e для работы с деревом файлов
• Авторизация OAuth 2.0 ВКонтакте на perl VKontakte::API::OAuth
• VKontakte::API v0.02