「antipop – Gmail/Gallina で写真付きモブログを」等で述べた通り、Gmail のメールをエントリとみなして Blog に仕立ててくれる Gallina というツールで遊んでいたのですが、てゆうか、元々 Blog 自体はすでにあるし、もしくはどうせなら XMLRPC で投げて既存ツールのエントリをでっちあげる方がいいかもな、ってんでちとごにょってみた。携帯電話等からの moblog 用に使えるかもしれないし、使えないかもしれない。しかし、そんなの既存のツールやサービスがすでにたくさんあるので、わざわざ自分で作る必要はないと思った。んで、Gmailog とか名付けた。己を馬鹿だと思った。
ごにょったつっても、単に Mail::Webmail::Gmail でぶっこ抜いたメールを XMLRPC::Lite を用いて metaWeblog API に投げるだけってな単純な話なのですが…。まぁそんなことはいいじゃないか！ 思い付いたからやってみたまでじゃないか！ そしてこの話自体、別に僕が思い付いたわけじゃないけどそんなのどうでもいいじゃないか！ やりたいからやった！ 食べたいから食べた！ Perl でごにょれるなら何でもよかった！ いまは反省している！ そんな純朴な生き様に憧れて…。
実際やってみたのが、以下。なんかおかしなところがある気がするけどキニシナイ！
やりくちを説明すると、まず、なんらかの条件に当てはまったら star を付加するテケトウなフィルタを作成します。んでもって、cron で下記 gmailog.pl をぶんまわして、star がついてるメールがあったらぶっこ抜き、画像が添付されてればそいつもとってきて、メールの題名と本文は metaWeblog.newPost で投稿、画像は metaWeblog.newMediaObject でサーバにうぷる。処理が終わった、あるいは、なんらかのエラーにより処理できなかったメールの star を剥奪。一回処理したメールは、次回以降は無視。そんな流れ。つまりはショボい。以下、コード。
#!/usr/bin/env perl
#
# gmailog.pl
#
# usage: perl gmailog.pl
#
# Copyright (c) 2004 kentaro <kentarok@gmail.com>
# gmailog.pl is distributed under the GPL.
#
use strict;
use warnings;
use Mail::Webmail::Gmail;
use XMLRPC::Lite;
use Image::Info qw(image_info);
# Congfigurations
my $gmail_username = 'Gmail のユーザ名';
my $gmail_password = 'Gmail のパスワード';
my $blog_username = 'Blog のユーザ名';
my $blog_password = 'Blog のパスワード';
my $blog_id = 'Blog ID';
my $blog_api = 'metaWeblog API の URI';
my $image_dir = 'archives/'; # 画像を置くディレクトリ
my $gmail = Mail::Webmail::Gmail->new (
username => $gmail_username,
password => $gmail_password,
encrypt_session => 1,
);
my $messages = $gmail->get_messages(label => $Mail::Webmail::Gmail::FOLDERS{'INBOX'});
for (@$messages) {
my $message = $gmail->get_indv_email(msg => $_);
if ($_->{starred}) {
my $id = $message->{$_->{id}}->{id};
my $image_info;
if (defined($message->{$_->{id}}->{attachments})) {
my $image = ${$gmail->get_attachment(attachment => ${ $message->{$_->{id}}->{attachments}}[0])};
eval { $image_info = post_data ('metaWeblog.newMediaObject', $image, $id); };
remove_star($id), next if $@;
}
my $title = prepare_text($message->{$_->{id}}->{subject});
my $body = image_html ($image_info->{url}) . prepare_text($message->{$_->{id}}->{body});
eval { post_data ('metaWeblog.newPost', $title, $body); };
remove_star ($id);
}
}
sub remove_star {
my $id = shift;
$gmail->edit_star(
action => 'remove',
msgid => $id,
);
}
sub post_data {
my $method = shift;
my @data = @_;
my @args = ($blog_id, $blog_username, $blog_password);
if ($method eq 'metaWeblog.newPost') {
push @args, ({ title => $data[0], description => $data[1]}, 1);
} elsif ($method eq 'metaWeblog.newMediaObject') {
push @args, ({ bits => $data[0], name => $image_dir.$data[1].get_image_ext (\$data[0])});
}
my $result = XMLRPC::Lite
-> proxy ($blog_api)
-> call ($method, @args)
-> result;
if ($result) {
return $result;
} else {
die 'Post failed...';
}
}
sub get_image_ext {
my $image = shift;
my $info = image_info($image);
if (my $error = $info->{error}) {
die "Can't parse image info: $error\n";
}
return ".$info->{file_ext}";
}
sub prepare_text {
my $text = shift;
$text =~ s|"(.*?)"|$1|g;
$text =~ s|\\||g;
$text =~ s|<br>|\n|g;
$text =~ s|<(.+?)>||g;
$text =~ s|\n|<br />\n|g;
$text =~ s|(https?://[-_.!~*'()a-zA-Z0-9/?:;\@&=+\$,%#]+)|<a href="$1">$1</a>|g;
return $text;
}
sub image_html {
my $image_uri = shift;
if ($image_uri) {
my $html = qq|<div class="MoblogImage">\n<img src="$image_uri" tilte="" alt=" " />\n</div>\n|;
return $html;
}
}
exit;
ていうか、エントリ書いちゃったらもう二度と見返さないだろうなってな酷いコードですね！ はは！