ホーム
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 で、Shift JIS でスクリプトを保存するには?

Perl でケータイ向けのサイトを書いているとき、シフトJIS でスクリプトを保存しないければならない場合がある (文字列テーブルなど)。このとき、 
Unrecognized character \x81 at ./your.cgi line XX.
といったエラーに悩まされているなら、
my $group = 'グループ';
などのように、「―」を「ー」で表すようにするとよい (Mac の場合は、「ー」が「―」になるようで、この現象が起こる)。または、文字化けする文字の後ろに「\」を付ける。 以下は、Shift JIS で文字化けする文字の一覧。文字化けを起こしやすいよく使う文字は強調しておいた。 文字 - Shift-JIS - Unicode での記述方法 
―　　81 5C　　　―
ソ　　83 5C　　　ソ
Ы　　84 5C　　　Ы
Ⅸ　　87 5C　　　Ⅸ
噂　　89 5C　　　噂
浬　　8A 5C　　　浬
欺　　8B 5C　　　欺
圭　　8C 5C　　　圭
構　　8D 5C　　　構
蚕　　8E 5C　　　蚕
十　　8F 5C　　　十
申　　90 5C　　　申
曾　　91 5C　　　曾
箪　　92 5C　　　箪
貼　　93 5C　　　貼
能　　94 5C　　　能
表　　95 5C　　　表
暴　　96 5C　　　暴
予　　97 5C　　　予
禄　　98 5C　　　禄
兔　　99 5C　　　兔
喀　　9A 5C　　　喀
媾　　9B 5C　　　媾
彌　　9C 5C　　　彌
拿　　9D 5C　　　拿
杤　　9E 5C　　　杤
歃　　9F 5C　　　歃
濬　　E0 5C　　　濬
畚　　E1 5C　　　畚
秉　　E2 5C　　　秉
綵　　E3 5C　　　綵
臀　　E4 5C　　　臀
藹　　E5 5C　　　藹
觸　　E6 5C　　　觸
軆　　E7 5C　　　軆
鐔　　E8 5C　　　鐔
饅　　E9 5C　　　饅
鷭　　EA 5C　　　鷭
偆　　ED 5C　　　偆
砡　　EE 5C　　　砡
Perl でケータイ向けのサイトを書いているとき、シフトJIS でスクリプトを保存しないければならない場合がある (文字列テーブルなど)。このとき、 
Unrecognized character \x81 at ./your.cgi line XX.
といったエラーに悩まされているなら、
my $group = 'グループ';
などのように、「―」を「ー」で表すようにするとよい (Mac の場合は、「ー」が「―」になるようで、この現象が起こる)。または、文字化けする文字の後ろに「\」を付ける。 以下は、Shift JIS で文字化けする文字の一覧。文字化けを起こしやすいよく使う文字は強調しておいた。 文字 - Shift-JIS - Unicode での記述方法 
―　　81 5C　　　―
ソ　　83 5C　　　ソ
Ы　　84 5C　　　Ы
Ⅸ　　87 5C　　　Ⅸ
噂　　89 5C　　　噂
浬　　8A 5C　　　浬
欺　　8B 5C　　　欺
圭　　8C 5C　　　圭
構　　8D 5C　　　構
蚕　　8E 5C　　　蚕
十　　8F 5C　　　十
申　　90 5C　　　申
曾　　91 5C　　　曾
箪　　92 5C　　　箪
貼　　93 5C　　　貼
能　　94 5C　　　能
表　　95 5C　　　表
暴　　96 5C　　　暴
予　　97 5C　　　予
禄　　98 5C　　　禄
兔　　99 5C　　　兔
喀　　9A 5C　　　喀
媾　　9B 5C　　　媾
彌　　9C 5C　　　彌
拿　　9D 5C　　　拿
杤　　9E 5C　　　杤
歃　　9F 5C　　　歃
濬　　E0 5C　　　濬
畚　　E1 5C　　　畚
秉　　E2 5C　　　秉
綵　　E3 5C　　　綵
臀　　E4 5C　　　臀
藹　　E5 5C　　　藹
觸　　E6 5C　　　觸
軆　　E7 5C　　　軆
鐔　　E8 5C　　　鐔
饅　　E9 5C　　　饅
鷭　　EA 5C　　　鷭
偆　　ED 5C　　　偆
砡　　EE 5C　　　砡
Posted on 2005-12-11 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 で、RSS を処理する

使用するモジュール 
use Encode;
use Encode::Guess;
use XML::RSS;
use LWP::UserAgent;
use HTTP::Request;
#!/usr/bin/perl

use Encode;
use Encode::Guess;
use XML::RSS;
use LWP::UserAgent;
use HTTP::Request;

my $url = 'https://perltips.twinkle.cc/index.rdf';

# 初期化
my $proxy = new LWP::UserAgent;       # UseAgent の作成
my $req   = new HTTP::Request(GET=>$url);
my $rss   = new XML::RSS;
my $res   = $proxy->request($req);    # $url にアクセスする
my $xml   = $res->content;            # コンテンツ (この場合は RSS/XML) を取得
my $enc   = guess_encoding($xml, qw/euc-jp shiftjis 7bit-jis utf8/); # 文字コードを判定
ref($enc) or die "Can't guess: $enc"; # 自動判定がうまくいかなかったときのエラー処理
# utf8 で保存 ($enc->name を decode することにより、utf8 で変数に保管される
$xml = decode($enc->name, $xml);

eval {
    $rss->parse($xml);
};

if($@) { # $rss->parse が失敗したとき
    print "error\n";
}

# @{$rss->{items}} に、RSS のすべてのエントリー (item) が入る
foreach my $item ( @{$rss->{items}} ) {

    # ケータイ (iモード) で出力したいので Shift_JIS にする
    my $title       = encode('shiftjis', $item->{title});
    my $description = encode('shiftjis', $item->{description}); # 上に同じ

    print qq|<a href="$item->{link}">$title</a>\n|; # タイトルをリンクつきで出力
    print qq|$description<br />\n|;                 # 概要 (description) を出力
}

exit;
参考リンク
使用するモジュール 
use Encode;
use Encode::Guess;
use XML::RSS;
use LWP::UserAgent;
use HTTP::Request;
#!/usr/bin/perl

use Encode;
use Encode::Guess;
use XML::RSS;
use LWP::UserAgent;
use HTTP::Request;

my $url = 'https://perltips.twinkle.cc/index.rdf';

# 初期化
my $proxy = new LWP::UserAgent;       # UseAgent の作成
my $req   = new HTTP::Request(GET=>$url);
my $rss   = new XML::RSS;
my $res   = $proxy->request($req);    # $url にアクセスする
my $xml   = $res->content;            # コンテンツ (この場合は RSS/XML) を取得
my $enc   = guess_encoding($xml, qw/euc-jp shiftjis 7bit-jis utf8/); # 文字コードを判定
ref($enc) or die "Can't guess: $enc"; # 自動判定がうまくいかなかったときのエラー処理
# utf8 で保存 ($enc->name を decode することにより、utf8 で変数に保管される
$xml = decode($enc->name, $xml);

eval {
    $rss->parse($xml);
};

if($@) { # $rss->parse が失敗したとき
    print "error\n";
}

# @{$rss->{items}} に、RSS のすべてのエントリー (item) が入る
foreach my $item ( @{$rss->{items}} ) {

    # ケータイ (iモード) で出力したいので Shift_JIS にする
    my $title       = encode('shiftjis', $item->{title});
    my $description = encode('shiftjis', $item->{description}); # 上に同じ

    print qq|<a href="$item->{link}">$title</a>\n|; # タイトルをリンクつきで出力
    print qq|$description<br />\n|;                 # 概要 (description) を出力
}

exit;
参考リンク
Posted on 2005-12-01 by yas |
« 先頭‹ 前123次 ›最終 »