コマネタ帳

PCや土いじりやゲームやオモチャ、思いつくまま細切れネタを書き散らかす日記

[プログラミング]北海道開発オフでTwitter botを作ったよ

第1回の北海道開発オフ部に参加してきました。オフの状況は別途レポートするとして、作っていたサイコロ振りボットがここまでできたよ、という「作業報告」をしたいと思います。あれだけ黙々と作業してて、何もできてないってのもあれなんで。

今回はユーザーと対話できるBotを考えていました。内容はともかく、とりあえずテンプレートとして使える方向を目指します。

2008/02/16 追記

「[プログラミング]Twitter Botの続き | コマネタ帳」に続きを書きました。

発言の取り込み方法

Twitter botがユーザーからの呼びかけを取り込むための方法は、大雑把に言って3つあります。それぞれ一長一短があります。理想論は「IMとTwitter APIのハイブリッド」ですが、残念ながら「IM」での実装までしかできていません＞＜。

Twitter APIで取得する。: 正式な方法なので、インターフェースが変更されにくいです。ただし、60分で70回のAPI制限を守らないとBotが(1時間)停止してしまいます。
TwitterのHTMLをScrapingする: 取得制限はありませんが、Twitter側でデザイン変更すると取得できなくなる恐れが。取得間隔を縮めることができるので、反応時間が短くて済む可能性があります。
IMへの通知を利用して、IM APIで取得する: 取得制限がないものの、通知メッセージは人間用なので変更される可能性があります。Scrapingよりは劇的な変更は考えにくいのがメリットかも。IMへの通知がこけることがあります。

Twitter UAはユーザーにIMの設定を要求できないこともあってTwitter APIで動作しますが、BotはIMの設定程度は問題にならないので、API制限回避のために使いたいところです。本当はTwitter UAでもIMの通知を取り込めると嬉しいんですけどね、Twitter専用のIMアカウントを用意するのはハードルが高すぎるのかな。

IMはJabber.jpを使います。「mootoh.log : RubyでTwitter bot を書く」が元ネタです。GMailとかも選択できますが、Jabberだと自分でサーバを立てることもできそうなんで。

ダイスの指定

TTRPGでのダイスロールの指定は「nDm」と書いて、「m面ダイスをn個振る」と言うものです(ルールブックを読んだのはバブルの頃までなので、最近は違う表現もありそうですが)。ただし、nが省略されていると「1」、mが省略されていると「6」とみなします。

で、Dの指定と定数値の四則演算くらいは欲しいのですが、やっぱりそこまで手が回りませんでした。計算機の作り方はTwitter Botの話ではないので、後回しです。

Followと通知

Followの通知はIMには来ないので、e-mailで受け取ってFollowとIM通知Onをおこないます。@nipotanさんの「Twitter でイチイチ follow するのが面倒くさい - にぽたん研究所」の方法ですが、メールサーバーのいない環境ですのでGmailをPOP3で見に行くようにします。そこ、今頃IMAPじゃなくてPOP3?とか言わない。

Perlモジュールとバッドノウハウ

ここまでの内容をもとにCPANからモジュールを入れていきます。

Net::Jabber
Mail::POP3Client
IO::Socket::SSL
Net::Twitter

俺の環境はWindowsのActivePerl 5.10.0 Build 1002ですが、うまくインストールできないモジュールが2つあります。

Net::XMPPはテストで反応しなくなります。Windows固有の問題のようなので、テスト無しでインストールします。

Net::SSLeayはPPMにbribesのRepositorｙ(http://www.bribes.org/perl/ppm)を登録してインストールします。DLLのバージョン違いでよくトラブルになるようです。

ソースコード

そんなこんなでソースコードへ突入します。まずはBot本体。

#!/user/bin/perl -w

use strict;
use warnings;
use utf8;
use Encode;
use Net::Jabber;
use YAML;
use Net::Twitter;

binmode STDOUT, ':encoding(shiftjis)';

my $server = 'jabber.jp';
my $username = 'Jabberアカウント';
my $password = 'Jabberパスワード';
my $resource = '';


$SIG{HUP} = \&Stop;
$SIG{KILL} = \&Stop;
$SIG{TERM} = \&Stop;
$SIG{INT} = \&Stop;

my $Connection = new Net::Jabber::Client(
  debuglevel => 1,
  debugfile  => "jabber.log",
);

$Connection->SetCallBacks(
  message=>\&InMessage,
  presence=>\&InPresence,
  iq=>\&InIQ);

my $status = $Connection->Connect(
  hostname=>$server
);

if (!(defined($status)))
{
  print "ERROR:  Jabber server is down or connection was not allowed.\n";
  print "        ($!)\n";
  exit(0);
}

my @result = $Connection->AuthSend(
  username=>$username,
  password=>$password,
  resource=>$resource);

if ($result[0] ne "ok")
{
  print "ERROR: Authorization failed: $result[0] - $result[1]\n";
  exit(0);
}

print "Logged in to $server...\n";

$Connection->RosterGet();

print "Getting Roster to tell server to send presence info...\n";

$Connection->PresenceSend();

print "Sending presence to tell world that we are logged in...\n";

while(defined($Connection->Process())) { }

print "ERROR: The connection was killed...\n";

exit(0);

sub Stop
{
  print "Exiting...\n";
  $Connection->Disconnect();
  exit(0);
}

sub InMessage
{
  my $sid = shift;
  my $message = shift;

  my $type = $message->GetType();
  my $fromJID = $message->GetFrom("jid");

  my $from = $fromJID->GetUserID();
  my $resource = $fromJID->GetResource();
  my $subject = $message->GetSubject();
  my $body = $message->GetBody();
  print "===\n";
  print "Message ($type)\n";
  print "  From: $from ($resource)\n";
  print "  Subject: $subject\n";
  print "  Body: $body\n";
#  print "===\n";
#  print $message->GetXML(),"\n";
  print "===\n";

  if ($body =~ /([^:]+):.*\@DiceTestBot *(.*)/i) {
    ProcMessage($1, $2);
  }
}


sub InIQ
{
  my $sid = shift;
  my $iq = shift;

  my $from = $iq->GetFrom();
  my $type = $iq->GetType();
  my $query = $iq->GetQuery();
  my $xmlns = $query->GetXMLNS();
  print "===\n";
  print "IQ\n";
  print "  From $from\n";
  print "  Type: $type\n";
  print "  XMLNS: $xmlns";
#  print "===\n";
#  print $iq->GetXML(),"\n";
  print "===\n";
}

sub InPresence
{
  my $sid = shift;
  my $presence = shift;

  my $from = $presence->GetFrom();
  my $type = $presence->GetType();
  my $status = $presence->GetStatus();
  print "===\n";
  print "Presence\n";
  print "  From $from\n";
  print "  Type: $type\n";
  print "  Status: $status\n";
#  print "===\n";
#  print $presence->GetXML(),"\n";
  print "===\n";
}

sub ProcMessage
{
  my $from = shift();
  my $body = shift();
  my @dices = ($body =~ /([0-9]*)[dD]([0-9]*)/gc);

  my $total = 0;
  my $dresult = '';
  my @dname;

  while (@dices) {
    my $n = (shift(@dices) or 1);
    my $m = (shift(@dices) or 6);
#    print "${n}D$m role...\n";
    push(@dname, "${n}D$m");
    my @dr1;
    my $i;
    for ($i=0; $i<$n; $i++) {
      my $d = int(rand($m)) + 1;
      push(@dr1, $d);
      $total += $d;
    }
    if ($dresult) {
      $dresult .= "+";
    }
    $dresult .= "[@dr1]";
  }
  $dresult =~ s/ /,/g;
  my $dv = "@dname";
  $dv =~ s/ /+/g;

  my $twit = Net::Twitter->new(
    username=>"Twitterユーザ名"   #ユーザー名
  , password=>"Twitterパスワード"  #パスワード
  );

  my $res = $twit->update('@'. "$from $dv=$total ($dr) です。");
}

次はFollow周り。

#!/user/bin/perl -w

use strict;
use warnings;
use utf8;
use Mail::POP3Client;
use IO::Socket::SSL;
use YAML;
use Net::Twitter;

binmode STDOUT, ':encoding(shiftjis)';

my $username  = 'Gmailアカウント'; # edit this
my $password  = 'Gmailパスワード';        # edit this

my $mailhost  = 'pop.gmail.com';
my $port      = '995';

my $pop = new Mail::POP3Client(
	USER		=> $username,
	PASSWORD	=> $password,
	HOST		=> $mailhost,
	PORT		=> $port,
	USESSL		=> 'true',
	DEBUG		=> 0,
);

# loop over msgs

while (1) {
	print "!\n";
	my @followers;

	for(my $i = 1; $i <= $pop->Count(); $i++) {
		
	#	print $pop->Head($i) . "\n";
	#	print $pop->Body($i) . "\n";
	#	print "\n";
		if ($pop->Body($i) =~ m%http://twitter.com/([0-9a-zA-Z]+)%) {
			my $name = $1;
			print "$name...\n";
			push(@followers, $name);
		}
	}

	if (@followers) {
		my $twit = Net::Twitter->new(
		  username=>"Twitterユーザ名"   #ユーザー名
		, password=>"Twitterパスワード"  #パスワード
		);
		foreach my $n (@followers) {
			$twit->follow($n);
			$twit->update("on $n");
		}
	}

	# close connection
	$pop->Close();

	sleep(60);
}

exit;