ホーム
warning: Creating default object from empty value in /var/www/drupal-5.23/modules/taxonomy/taxonomy.module on line 1418.

Perl で、添付ファイル付きのメールを送る方法

Perl で、
open(SEND, '/usr/sbin/sendmail') || die;
などとせずにモジュールを使ってメールを送信するには、以下のようにする。 使用するモジュール 
use Net::SMTP;
use MIME::Entity;
#!/usr/bin/perl

use Net::SMTP;
use MIME::Entity;

# Settings
our $SENDER          = '送信元のメールアドレス';
our $RECIPIENT       = '送信先のメールアドレス';
our $SUBJECT         = 'タイトル';
our $ATTACHED_FILE_1 = '/home/youraccount/添付ファイル名その1.jpg';
our $ATTACHED_FILE_2 = '/home/youraccount/添付ファイル名その2.jpg';

# Create object
my $smtp=Net::SMTP->new('localhost',
                        HELLO=>'yourmailsever.yourdomain.com');

# Built headers
$smtp->mail($SENDER);                 # Sender
$smtp->to  ($RECIPIENT);              # Receiver

# Built Data (Create data by MIME::Entity)
$smtp->data();
my $mime = MIME::Entity->build(
            From    =>    $SENDER   , # Sender   (data)
            To      =>    $RECIPIENT, # Receiver (data)
            Subject =>    $SUBJECT  , # Subject
            Data    => ['']);         # body

# Attached file
$mime->attach(
        Path     => $ATTACHED_FILE_1,
        Type     => 'image/jpeg',
        Encoding => 'Base64'
);

# Attached file
$mime->attach(
        Path     => $ATTACHED_FILE_2,
        Type     => 'image/jpeg',
        Encoding => 'Base64'
);

# Attached file (Text)
# $mime->attach(
#    Path     => $ATTACHED_FILE,
#    Type     => 'text/plain',
#    Encoding => '-SUGGEST'
#);

$smtp->datasend($mime->stringify); # transfer strings

# Data termination and send mail
$smtp->dataend();

#Quit SMTP connection
$smtp->quit;

# for debug
print "Sender    : $SENDER\n";
print "Recipient : $RECIPIENT\n";
print "Attached  : $ATTACHED_FILE\n";

1;
Perl で、
open(SEND, '/usr/sbin/sendmail') || die;
などとせずにモジュールを使ってメールを送信するには、以下のようにする。 使用するモジュール 
use Net::SMTP;
use MIME::Entity;
#!/usr/bin/perl

use Net::SMTP;
use MIME::Entity;

# Settings
our $SENDER          = '送信元のメールアドレス';
our $RECIPIENT       = '送信先のメールアドレス';
our $SUBJECT         = 'タイトル';
our $ATTACHED_FILE_1 = '/home/youraccount/添付ファイル名その1.jpg';
our $ATTACHED_FILE_2 = '/home/youraccount/添付ファイル名その2.jpg';

# Create object
my $smtp=Net::SMTP->new('localhost',
                        HELLO=>'yourmailsever.yourdomain.com');

# Built headers
$smtp->mail($SENDER);                 # Sender
$smtp->to  ($RECIPIENT);              # Receiver

# Built Data (Create data by MIME::Entity)
$smtp->data();
my $mime = MIME::Entity->build(
            From    =>    $SENDER   , # Sender   (data)
            To      =>    $RECIPIENT, # Receiver (data)
            Subject =>    $SUBJECT  , # Subject
            Data    => ['']);         # body

# Attached file
$mime->attach(
        Path     => $ATTACHED_FILE_1,
        Type     => 'image/jpeg',
        Encoding => 'Base64'
);

# Attached file
$mime->attach(
        Path     => $ATTACHED_FILE_2,
        Type     => 'image/jpeg',
        Encoding => 'Base64'
);

# Attached file (Text)
# $mime->attach(
#    Path     => $ATTACHED_FILE,
#    Type     => 'text/plain',
#    Encoding => '-SUGGEST'
#);

$smtp->datasend($mime->stringify); # transfer strings

# Data termination and send mail
$smtp->dataend();

#Quit SMTP connection
$smtp->quit;

# for debug
print "Sender    : $SENDER\n";
print "Recipient : $RECIPIENT\n";
print "Attached  : $ATTACHED_FILE\n";

1;
Posted on 2006-01-25 by yas |

Perl での、文字列の扱い:<br />シングルクォートとダブルクォーテーションの違い

まずはこのエントリのタイトルにある「シングルクォート ('…') とダブルクォーテーション ("…")」、なぜ 「クォート」 と 「クォーテーション」 なのか? という細かい＾＾；質問は置いておいて、Perl で文字列を表現する方法は実はいくつかあるのだということに注意したい。基本的にはシングルクォートとダブルクォーテーションの違いがある。シングルクォートの場合は、その中に書いた文字列はそのまま文字列として Perl に解釈される。特にダブルクォーテーションの場合は、文字列の中に変数を埋め込める。これは便利な反面、やっかいなことになることがある。例えばメールアドレスをダブルクォーテーションで囲んだ場合には、メールアドレスには必ずアットマーク 「@」 があり、この文字に Perl が出くわしたときに 「配列 」と解釈してしまうため、多くの場合は自分の予期しない結果か、エラーとなる。
my $str = 'Perl では';
print $str . '文字列をシングルクォートで囲むのが基本';
print "$str このように、ダブルクォーテーションで囲むことができる";
なお、文字列の連結にはピリオド「.」を使う。
print '文字列を' . '連結する';
また、'…' と "…" はそれぞれ以下のように書くことができる。
print q|これはシングルクォートで囲ったのと同じ意味|;
print qq|これはダブルクォーテーションで囲ったのと同じ意味|;

print q/…qの後にくる記号はスラッシュとかも使える/;
print qq/…同じく qqの後にくる記号はスラッシュとかも使える/;
my $mail = 'support@twinkle.cc';
print $mail;
→これはきちんと support@twinkle.cc と表示される。

$mail = "support@twinkle.cc";
print $mail;
→ こちらは support.cc と表示される。なぜなら、@twinkle が変数とみなされるからである。
→ use strict を使ったらエラーとなる。
まずはこのエントリのタイトルにある「シングルクォート ('…') とダブルクォーテーション ("…")」、なぜ 「クォート」 と 「クォーテーション」 なのか? という細かい＾＾；質問は置いておいて、Perl で文字列を表現する方法は実はいくつかあるのだということに注意したい。基本的にはシングルクォートとダブルクォーテーションの違いがある。シングルクォートの場合は、その中に書いた文字列はそのまま文字列として Perl に解釈される。特にダブルクォーテーションの場合は、文字列の中に変数を埋め込める。これは便利な反面、やっかいなことになることがある。例えばメールアドレスをダブルクォーテーションで囲んだ場合には、メールアドレスには必ずアットマーク 「@」 があり、この文字に Perl が出くわしたときに 「配列 」と解釈してしまうため、多くの場合は自分の予期しない結果か、エラーとなる。
my $str = 'Perl では';
print $str . '文字列をシングルクォートで囲むのが基本';
print "$str このように、ダブルクォーテーションで囲むことができる";
なお、文字列の連結にはピリオド「.」を使う。
print '文字列を' . '連結する';
また、'…' と "…" はそれぞれ以下のように書くことができる。
print q|これはシングルクォートで囲ったのと同じ意味|;
print qq|これはダブルクォーテーションで囲ったのと同じ意味|;

print q/…qの後にくる記号はスラッシュとかも使える/;
print qq/…同じく qqの後にくる記号はスラッシュとかも使える/;
my $mail = 'support@twinkle.cc';
print $mail;
→これはきちんと support@twinkle.cc と表示される。

$mail = "support@twinkle.cc";
print $mail;
→ こちらは support.cc と表示される。なぜなら、@twinkle が変数とみなされるからである。
→ use strict を使ったらエラーとなる。
Posted on 2006-01-07 by yas |

Perl で、メールサーバに送られてきたメールを処理する

Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。 使用するクラス 
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use Unicode::Japanese;

my ($mail) = &parse;
print "From: " . $mail->{sender} . "\n";
print "To: " . $mail->{recipient} . "\n";
print "Subject: " . $mail->{subject} . "\n";

sub parse {

    my ($mail);

    # Parser Setting
    my $parser = new MIME::Parser;
    $parser->output_to_core(1);    # Keeps body analyzed internally
    $parser->tmp_recycling (1);    # Recycles the temporary stuff

    my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";

    # Headers
    $mail->{sender   } =  $entity->head->get('from'   );
    $mail->{subject  } =  $entity->head->get('subject');
    $mail->{recipient} =  $entity->head->get('to'     );
    $mail->{recipient} =~ s/\n//g;

    # From
    @addrs = Mail::Address->parse($mail->{sender});
    foreach $addr (@addrs) {
        $mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
    }

    # Subject
    my $subject = $mail->{subject};
    $lws      = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
    $ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
    $subject  =~ s/\n//g;
    $subject  =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
    $subject  =~ s/$lws/ /go;
    $subject  =~ s/$ew_regex/decode_base64($1)/egio;
    $subject  = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
    $mail->{subject} = $subject;

    # Get MIME
    ($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
    $mail->{body   } =  Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
    $mail->{body   } =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line
    $mail->{subject} =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line

    return $mail;
}

sub getEntities {

    my $entity = shift;
    my $body, $filename, $mimetype, $object;

    # BODY
    my @parts = $entity->parts;
    if (@parts) {                   # multipart...

        my $i;
        foreach $i (0 .. $#parts) { # dump each part...

            &getEntities($parts[$i]);
        }
    } else {                        # single part...

        # Get MIME type, and display accordingly...
        my ($type, $subtype) = split('/', $entity->head->mime_type);
        my $bodyhandle = $entity->bodyhandle;

        if ($type =~ /^(text|message)$/) {      # text

            $body .= $bodyhandle->as_string;

        } else {                                # binary

            $filename= $entity->head->recommended_filename;
            $mimetype = $entity->head->mime_type;
            $object = $bodyhandle->as_string;
            binmode($object);
            # if we want to store it as BASE64, you can continue the processs here
        }
    }

    return ($body, $filename, $mimetype, $object);
}

1;
Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。 使用するクラス 
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use Unicode::Japanese;

my ($mail) = &parse;
print "From: " . $mail->{sender} . "\n";
print "To: " . $mail->{recipient} . "\n";
print "Subject: " . $mail->{subject} . "\n";

sub parse {

    my ($mail);

    # Parser Setting
    my $parser = new MIME::Parser;
    $parser->output_to_core(1);    # Keeps body analyzed internally
    $parser->tmp_recycling (1);    # Recycles the temporary stuff

    my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";

    # Headers
    $mail->{sender   } =  $entity->head->get('from'   );
    $mail->{subject  } =  $entity->head->get('subject');
    $mail->{recipient} =  $entity->head->get('to'     );
    $mail->{recipient} =~ s/\n//g;

    # From
    @addrs = Mail::Address->parse($mail->{sender});
    foreach $addr (@addrs) {
        $mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
    }

    # Subject
    my $subject = $mail->{subject};
    $lws      = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
    $ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
    $subject  =~ s/\n//g;
    $subject  =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
    $subject  =~ s/$lws/ /go;
    $subject  =~ s/$ew_regex/decode_base64($1)/egio;
    $subject  = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
    $mail->{subject} = $subject;

    # Get MIME
    ($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
    $mail->{body   } =  Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
    $mail->{body   } =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line
    $mail->{subject} =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line

    return $mail;
}

sub getEntities {

    my $entity = shift;
    my $body, $filename, $mimetype, $object;

    # BODY
    my @parts = $entity->parts;
    if (@parts) {                   # multipart...

        my $i;
        foreach $i (0 .. $#parts) { # dump each part...

            &getEntities($parts[$i]);
        }
    } else {                        # single part...

        # Get MIME type, and display accordingly...
        my ($type, $subtype) = split('/', $entity->head->mime_type);
        my $bodyhandle = $entity->bodyhandle;

        if ($type =~ /^(text|message)$/) {      # text

            $body .= $bodyhandle->as_string;

        } else {                                # binary

            $filename= $entity->head->recommended_filename;
            $mimetype = $entity->head->mime_type;
            $object = $bodyhandle->as_string;
            binmode($object);
            # if we want to store it as BASE64, you can continue the processs here
        }
    }

    return ($body, $filename, $mimetype, $object);
}

1;
Posted on 2005-12-06 by yas |

Perl で、メールアドレスの自動リンクをする

以下のサブルーチン getEmails で抜き出したテキスト中のメールアドレス一覧を emailToLink が配列で受け取る。getEmails 中の　while はヘタすると無限ループに陥る可能性があるので変換対象のテキストで 50個まで抜き出すようにしている。 使用するモジュール 
なし
#!/usr/bin/perl

sub getEmails {

    my $text = shift;
    my @emails;

    my $email_regex =
      q{(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥}
    . q{¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][}
    . q{^¥¥¥¥¥x80-¥xff¥n¥015"]*)*")(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x}
    . q{80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-}
    . q{¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][^¥¥¥¥¥x80-¥xff¥n¥015"]*)*"))*@(?:[^(}
    . q{¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥0}
    . q{00-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[^¥x80-¥xff])*}
    . q{¥])(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,}
    . q{;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[}
    . q{^¥x80-¥xff])*¥]))*};

    my $i = 0;
    while($text =~ /($email_regex)/o && $i++ < 50) {
        push(@emails, $1);
        $text =~ s/$1/XXXXXXXXXX/g;
    }

    return @emails;
}

sub emailToLink {

    my $text = shift;
    my @emails = &getEmails($text);

    foreach my $email (@emails) {
        $text =~ s/$email/<a href=mailto:$email>$email<¥/>/g;
    }

    return $text;
}

1;
参考リンク：
以下のサブルーチン getEmails で抜き出したテキスト中のメールアドレス一覧を emailToLink が配列で受け取る。getEmails 中の　while はヘタすると無限ループに陥る可能性があるので変換対象のテキストで 50個まで抜き出すようにしている。 使用するモジュール 
なし
#!/usr/bin/perl

sub getEmails {

    my $text = shift;
    my @emails;

    my $email_regex =
      q{(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥}
    . q{¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][}
    . q{^¥¥¥¥¥x80-¥xff¥n¥015"]*)*")(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x}
    . q{80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-}
    . q{¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][^¥¥¥¥¥x80-¥xff¥n¥015"]*)*"))*@(?:[^(}
    . q{¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥0}
    . q{00-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[^¥x80-¥xff])*}
    . q{¥])(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,}
    . q{;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[}
    . q{^¥x80-¥xff])*¥]))*};

    my $i = 0;
    while($text =~ /($email_regex)/o && $i++ < 50) {
        push(@emails, $1);
        $text =~ s/$1/XXXXXXXXXX/g;
    }

    return @emails;
}

sub emailToLink {

    my $text = shift;
    my @emails = &getEmails($text);

    foreach my $email (@emails) {
        $text =~ s/$email/<a href=mailto:$email>$email<¥/>/g;
    }

    return $text;
}

1;
参考リンク：
Posted on 2005-02-08 by yas |
« 先頭‹ 前123