
Отправка письма на 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
Похожие записи
21:50:16 18.07.2011
verityoky
Хороший блог!
Развивайте темы дальше.
Сайт Ваш почему-то херово раскрученный и малоизвестен. Рекомендуем оптимизировать Ваш ЖЖ с помощью программы XRumer 7 Elite (ХРумер 7 Элите) скачать можно тут http://x-rumer.ru/ говорят эффективная программа для раскрутки ЖЖ журналов.