PerlでTwitterのBotを作ってみる(IM経由で発言するようにした)

前回のエントリはこちら。

PerlでTwitterのBotを作ってみる -> As a Futurist…

ここでTODOとしてあげていた、Botの発言をAPI経由からIM経由に することに成功したのでメモ。たいしたことはやってません。

IMはJabber.jpの運営しているJabberサーバにアクセスしていて、 それはNet:Jabber::Clientというクラスのインスタンスが担当しています。 なので、こいつのメソッドで多分メッセージが送れるはずだと 思って探したら、もろSend()というメソッドがありました。

使い方は、引数にNet::Jabber::Messageインスタンスを与えればよい みたい。このクラスの細かい作り方は知りませんが、とりあえず、 toとtypeとbodyを設定すればよさそうなのでやってみたら上手くいきました。

注意すべきは、toには@リプライしてくれたTwitterユーザの アカウントを指定するのではなく、あくまでIM上のTwitter君に 投げてあげないといけないのですが、それはメッセージを取得したときに IM上のIDとして取得できている(InMessage内の$fromJID)ので、 これをProcMessageに引数で渡しておくことで解決。なんて安直。

ということで、マイナーチェンジしたソースコード。

#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Jcode;
use Net::Jabber;
use YAML;
use Net::Twitter;

binmode STDOUT, ':encoding(utf-8)';

my $server = 'jabber.jp';
my $jabbername = 'jabberuser';#jabber.jpのユーザネーム
my $jabberpass = 'jabberpass';#jabber.jpのパスワード
my $resource = '';
my $twittername = 'botuser';#TwitterのBot用ユーザネーム
my $twitterpass = 'botpass';#TwitterのBot用パスワード

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

my $Connection = new Net::Jabber::Client(
# なぜかdebugを書くときに、Wide character in print atというエラーが出る
#  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=>$jabbername,
  password=>$jabberpass,
  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";

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

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";
}

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";
}

sub ProcMessage
{
  my $from = shift();#差出人Twitterユーザ名
  my $body = shift();#発言内容
  my $fromjid = shift();

#  my $twit = Net::Twitter->new(
#    username=>$twittername
#  , password=>$twitterpass
#  );

  my $mes = '@'. "$from $body". "とか言って、バッカじゃないの!";
#  Jcode::convert(\$mes, 'utf8');

  my $message = Net::Jabber::Message->new();
  $message->SetMessage(
      "to" => $fromjid,
      "type" => "chat",
      "body" => $mes);

  $Connection->Send($message);

#  my $res = $twit->update($mes);
  print "$mes \n";
}

すでにNet::Twitterを読み込む意味はないことに今気づいたけど、まぁいいや。

自動Follow返しはとりあえず動いたけど、他にいい手がないか考え中。