Next Previous Contents

4. email

4.1 Как отправить почту из скрипта на Perl?

Простой способ для счастливых владельцев Unix

        
open MAIL, '|/path/to/your/sendmail -t'; # Pipe к sendmail
print MAIL "From: mailrobot@my.host\n",
           "To: webmaster@my.host\n",
           "Subject: Wow! I got some mail for you!!!\n\n",
            $message;
close MAIL or die "Sendmail failed: $!";

Более гибкий способ -- Mail::Mailer

#!/usr/bin/perl -w
use strict;
use Mail::Mailer;

my $mailer = new Mail::Mailer;
my %headers;
$headers{"To"} = 'apavel';
$headers{"Subject"} = 'Привет';
my $body = "Привет!\nКак дела?";

$mailer->open(\%headers);
print $mailer $body;
$mailer->close;

4.2 Как отправить почту с вложениями (attachments)?

Используя MIME::Entity из комплекта MIME::Tools

#!/usr/bin/perl -w
use strict;
use MIME::Entity;

my $message = MIME::Entity->build(
        To      => 'apavel',
        Subject => "Пошлые анекдоты и голые девки",
        Data    => ["Пошлые анекдоты тут"],
        Charset => "koi8-r",
        Encoding=> "8bit",
        );
$message->attach(
        Path     => "naked_girls.jpg",
        Type     => "image/jpg",
        Encoding => "base64",
        Disposition=>"attachment",
        );

open SENDMAIL, "|/usr/sbin/sendmail -t" or die "sendmail: $!";
$message->print(\*SENDMAIL);
close SENDMAIL or die "sendmail failed: $!";

4.3 Как определить правильность адреса электронной почты Internet?

Гарантированно -- никак. Вы можете проверить адрес на правильность синтаксиса при помощи Email::Valid. И все. Если нужен гарантированно правильный e-mail для web-сайта, вы можете воспользоваться методом от Алексея Тутубалина: требовать пароль для доступа к информации, а сам пароль высылать по электронной почте. Тогда человек должен будет указать свой e-mail, конечно же, если ему интересна эта информация с вашего сайта.

4.4 Как получать почту в Unix?

Самое простое - прописать ваш скрипт в .forward или /etc/aliases:

.forward:

| /path/to/your/script

/etc/aliases

pupkins:  "|/path/to/yours/script"

Более подробно смотрите в документации на ваш MTA.

Скрипт должен читать из стандартного потока ввода. Например:

#!/usr/bin/perl

open (F,">/tmp/mbox") or die $!;
while (<STDIN>) {
   print F $_;
}
close (F);

4.5 Как разобрать письмо на составные части?

Ручным разбором

письмо состоит из двух частей - заголовка и тела. Заголовок состоит из пары: имя заголовка и значение заголовка, разделенные двоеточием ":", например: test (более подробно смотрите в rfc 822, 2822). Тело письма - просто текст. Пример скрипта для разбора письма.

#!/usr/bin/perl

# Читаем письмо со стандартного потока ввода STDIN

my (%head, @body);     # %head - пары { header => value }
                      # @body - тело письма
{
        local $/ = "";      # читаем все до пустой строки - разделителя
        my $head = <STDIN>; # заголовка и тела письма
        $head =~ s|\n\s+| |gs; # если значение заголовка длинное,
                            # то он переносится на следующую строку и
                            # начинается с пробельного символа. соединяем строку
        my @head = split /\n/,$head;        # делим по строкам заголовок;
        # разделяем строку вида Subject: test на пары "Subject" и "test",
        # и возвращаем их как "subject" => "test"
        %head = map { my ($a,$b) = split (/:\s+/,$_,2); lc $a => $b } @head;
        # теперь в %head собраны все заголовки и их значения
        # предупреждение: я не рассматриваю случай присутствия в заголовке
        # письма одинаковых заголовков (как то "Received:") - как их сделать -
        # ваша задача.
}
@body = <STDIN>;      # теперь в body тело письма, и с ним можно работать.
Теперь можно смотреть на $head{'content-type'} и решать, что с ним делать.

Используя MIME::Parser

#!/usr/bin/perl -w
use strict;
use MIME::Parser;

# Построить объект MIME::Parser для разбора письма
my $parser = new MIME::Parser;
# Сохранять временные файлы в /tmp
$parser->output_under("/tmp");
# Разобрать STDIN. 
my $entity = $parser->parse(\*STDIN);

# Теперь $entity -- это объект MIME::Entity

# Получить какой-нибудь заголовок письма можно у $entity->head (объект MIME::Head):
my $subject = $entity->head->get('Subject');

# Если это письмо состоит из одной части, то ее можно получить так:
my $body = $entity->body_as_string;

# ... Но в 1996 netscape выкатила свой MUA, который по-дефолту отправлял одно 
# и тоже сообщение в HTML и text/plain и легкая жизнь для разработчиков
# почтовых систем закончилась. Пришлось разбирать MIME.

if ($entity->is_multipart) {
        for (my $i = 0; $i <  $entity->parts(); $i++) {
                my $part = $entity->parts($i);
                # Теперь $part -- это объект MIME::Entity, содержащий одну из частей этого 
                # этого письма.  Обратите внимание, что $part в некоторых случаях
                # может тоже содержать другие части, например, для MIME типа message/rfc822,
                # так что в общем случае, на этом месте должна быть рекурсивная подпрограмма
                # разбора

                # Открыть эту часть для чтения
                my $IO = $part->bodyhandle->open("r") or die "open body: $!";
                while (defined($_ = $IO->getline)) {
                        # Делать чего-то с ней
        }
                $IO->close();
        }       
} else {
        # Это сообщение из одной части:
        $entity->body_as_string;
}       

# Удалить временные файлы
$entity->purge();

4.6 Как декодировать строки типа =?koi8-r?B?UmU6IPfFzt?

Можно использовать MIME::Words,

#!/usr/bin/perl -w
use MIME::Words qw(:all);
use Convert::Cyrillic;
use strict;

my $string = 'Re: =?KOI8-R?B?0sHCz9TB ?= c MIME =?KOI8-R?B?zsE= ?= perl ';

# Простой вариант:
my $decoded = decode_mimewords($subject);
# Но он не выдает информации о кодировке, так что лучше использовать
# другую форму вызова:

my $decoded = join("", map {xcode(${$_}[1], ${$_}[0])} decode_mimewords($string)
print "decoded: $decoded\n";

# процедура перекодирования из чарсета, используемого в сообщении
# в koi8
sub xcode {
        my ($charset, $src) = @_;
        my %charsets = (
                'windows-1251'=>'WIN',
                'iso8859-5'=>'ISO',
                'koi8-r'=>'KOI8',
                'koi8r'=>'KOI8',
                'koi8-u'=>'KOI8',
                'utf-8'=>'UTF8',
                'utf8'=>'UTF8'
        );
        return $src unless ($charsets{lc($charset)});
        Convert::Cyrillic::cstocs($charsets{lc($charset)}, 'KOI8', $src);
}

4.7 Как получить почту по POP3?

Используя Net::POP3.

#!/usr/bin/perl -w
use strict;
use Net::POP3;

my $server = "oops";

my $pop = new Net::POP3($server);
# Залогинится
my $msgs = $pop->login("alladin", "opensesame"); 
# login возвращает undef, если не удалось залогинится и число сообщений
# в почтовом ящике, если удалось.
die "Login failed" if not defined $msgs;
print "$msgs сообщений\n";
# Список сообщений.  list возвращает ссылку на хэш, ключами которого являются
# номера сообщений, а значениями -- размер письма в байтах.
my %list = %{$pop->list};

for my $msg_num (keys(%list)) {
        print "#$msg_num - $list{$msg_num} байт\n";
        # Получить сообщение.  get вернет ссылку на массив строк
        my $msg = $pop->get($msg_num);
        # сделать с ним чего-нибудь
        open F, ">msg$msg_num" or die "msg$msg_num: $!";
        print F join("", @$msg);
        close F;
        # Отметить сообщение для удаления.  Оно будет удалено 
        # при закрытии коннекта к серверу
        $pop->delete($msg_num);
}

# Закрыть соединение с сервером
$pop->quit();

Next Previous Contents