読者です 読者をやめる 読者になる 読者になる

携帯からメールでWikipedia

Perl

404 Blog Not Found:perl - mail to twitter gateway
をみて触発されて(?)、メールの本文にクエリを書いてメールするとWikipediaの内容が返信されてくるメールゲートウェイPerlで書いてみた。ほぼ生まれて初めてCPANを駆使したから内容的にはかなり適当。まだ文字化けが残ってるけど一応ちょこっと調べたいときとかには使えそう。
ソースを公開しておく。

#!/usr/bin/perl -w
use warnings;
use strict;
use Net::POP3;
use Net::SMTP;
use WWW::Wikipedia;
use utf8;
use Encode qw(from_to);
use Encode;
use MIME::Base64;

my $smtp_server = 'SMTPサーバ';
my $pop_server  = 'POPサーバ'; # POP before SMTP用
my $username    = 'POPのユーザ名';
my $pass        = 'POPのパスワード';
my $query       = '';
my $from        = '';
my $is_base64   = 0;
my $charset     = 'iso-2022-jp';

while(<>){
    if (1 .. /^$/){
        if (!$from && /^From:?\s+(\S+)/o){
            $from = $1;
        }
        $charset = $1 if /^Content-Type:.*?charset=([A-Za-z0-9_\-]+)/io;
        $is_base64 = 1 if /^Content-Transfer-Encoding:\s+base64/io;
    }else{
        $query .= $_;
    }
}
$query = decode_base64($query) if $is_base64;
$query =~ s/\n.*//g;
my $subject = $query;
$query = decode($charset, $query);

my $wiki = WWW::Wikipedia->new(language => 'ja');
my $entry = $wiki->search($query);
my $msg = join "", $entry->fulltext();
$msg =~ s/-\s*\n#?\s*//g; # WWW::Wikiediaで癖がある部分を取り除く。
from_to($msg,"utf8","iso-2022-jp");

# POP before SMTP用
my $pop = Net::POP3->new($pop_server);
if($pop->login($username, $pass) >= 0) {
    $pop->quit;
}else{
    die "can not login.\n";
}

# SMTP
my $smtp = Net::SMTP->new(
                          Host  => $smtp_server,
                          Hello => $smtp_server,
                         );
# 送信元の指定
my $from_server = '"Wikipedia Mail" <返信メールの差し出しアドレス>';
$smtp->mail($from_server);
$smtp->to($from);
# 今の時間
my $date = &date;

$smtp->data();
$smtp->datasend("Date:$date\n");
$smtp->datasend("From:$from_server\n");
$smtp->datasend("To:$from\n");
$smtp->datasend("Subject:$subject\n");
$smtp->datasend("Content-Transfer-Encoding: 7bit\n");
$smtp->datasend("Content-Type: text/plain;charset=\"ISO-2022-JP\"\n\n");
$smtp->datasend("$msg\n");
$smtp->dataend();
$smtp->quit;

sub date {
    $ENV{'TZ'} = "JST-9";
    my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
    my @week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    my @month = (
                 'Jan','Feb','Mar','Apr','May','Jun',
                 'Jul','Aug','Sep','Oct','Nov','Dec'
                );
    my $d = sprintf("%s, %d %s %04d %02d:%02d:%02d +0900 (JST)",
                    $week[$wday],$mday,$month[$mon],$year+1900,$hour,$min,$sec);
    return $d;
}

単純にWWW::WikipediaでとってきてNet::SMTPで返信するだけのものです。まだWWW::Wikipediaでとってきたテキストの整形がうまくいかなくて文字化けすることがあるけど気がついたら直していきます。実用にはさほど問題ないはず。
メールヘッダを読み込むところは404 Blog Not Foundさんのところのを拝借しました。ただ、Fromを抽出する正規表現のところでFrom直後の「:」が抜けていたので付け加えました。ありがとうございました。

あとは上のスクリプトを775とかにして、qmailなら.qmailあたりに

| preline /path/wikipediamail.pl

とか書いておけば動くと思います。