コマネタ帳

「[プログラミング]北海道開発オフでTwitter botを作ったよ | コマネタ帳」での残務をこなします。かなり日数が空いてしまいましたが、少しは進捗したところをお見せしないと、前回の記事をブックマークしたりはてなスターつけたりして頂いた値がなくなります＞＜。Perl用語がかなり不自由なんで、突っ込みどころ満載のエントリですが良しなにお願いします。

Twitter API への対応

「＠ドリブンなTwitter自動投稿スクリプト - おとなりさんガーデン・分家 - はてなグループ::ついったー部」がとても参考になりますので、頂いてしまいました＞＜。しかし、1周期に20件を超えるRepliesがあると見逃してしまう問題はそのままです。20件を超えたことを検出する上手い方法が思いついていません。20件目が新しければ、という条件で次のページを見に行けばいいのかな?

メッセージIDでAPIからの重複を削除していますが、それらを記録するためにハッシュを使うことにしました。ついでにIMからのメッセージとの重複を削除するためにも使います。でも、何も考えずtieしたハッシュにマルチバイトを入れると「Wide character …」というエラーが発生します。以下のコードのようなエンコードの調整が必要です。

  $db = tie(%IDS, 'DB_File', $datafile) or die "Can't access db: $!";
  $db->filter_store_key  (sub{$_ = encode("utf8", $_)});
  $db->filter_store_value(sub{$_ = encode("utf8", $_)});
  $db->filter_fetch_key  (sub{$_ = decode("utf8", $_)});
  $db->filter_fetch_value(sub{$_ = decode("utf8", $_)});

DMへの対応

TTRPGをやるなら、ゲームマスターがプレイヤーに判らないようにダイスロールする機能は必須です。つまりはDMへの対応はRepliesと同じくらいの頻度で必要です。

Repliesの処理と同じようにDMの処理を実装すればOK。ただし、プロトタイプ宣言の違いか、new_direct_messageの呼び出しは無名ハッシュの書き方が必要のようです。

簡単なスケジューラ

やることが増えたので、簡単なタスクスケジューラを書いてみました。1分毎にRepliesとDMを交互に取得し、Jabberへ10秒ごとにアクセスします。適当なんで本当にちゃんと動くかわかりません（ぉ。

コード

では現在のコードです。Followまわりは変わっていないので略。

#!/user/bin/perl -w

use strict;
use warnings;
use utf8;
use Encode;

use YAML;
use DB_File;
use Fcntl;

use Net::Twitter;
use Net::Jabber;

binmode STDOUT, ':encoding(shiftjis)';

my $twitterid = 'Twitter id';
my $twitterpass = 'Twitter pass';

my $datafile = 'dicebot.dat';

my $imserver = 'jabber.jp';
my $imusername = 'Jabber id';
my $impassword = 'Jabber pass';
my $imresource = '';
my $imcount;

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

my %IDS;
my $db;
my $bot;
my $Connection;

sub init
{
  $db = tie(%IDS, 'DB_File', $datafile) or die "Can't access db: $!";
  $db->filter_store_key  (sub{$_ = encode("utf8", $_)});
  $db->filter_store_value(sub{$_ = encode("utf8", $_)});
  $db->filter_fetch_key  (sub{$_ = decode("utf8", $_)});
  $db->filter_fetch_value(sub{$_ = decode("utf8", $_)});
}

sub initTwitter
{
  $bot = new Net::Twitter(
    username => $twitterid,
    password => $twitterpass,
  );
}

sub initJabber
{
  $Connection = new Net::Jabber::Client();
  $Connection->SetCallBacks(message=>\&InMessage);
  my $status = $Connection->Connect(
    hostname=>$imserver
  );

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

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

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

  $Connection->RosterGet();
  $Connection->PresenceSend();
}

sub processMessage
{
  my $input = shift;

  # ここでメッセージを処理する

  $input;
}

sub reply
{
  my ($type, $input, $screen_name, $text) = @_;
  my $key = (($input eq 'A')?'I':'A').$text;
  if ($IDS{$key}) {
    # 存在したらAPIとIMの両方から来たメッセージ
    my ($count, $time) = split /\s+/, $IDS{$key};
    $count--;
    if ($count <= 0) {
      # 返信済みの筈なので%IDSから削除
      delete $IDS{$key};
    } else {
      $IDS{$key} = $count . ' ' . $time;
    }
    return;
  }
  $key = $input . $text;
  if ($IDS{$key}) {
    my ($count, $time) = split /\s+/, $IDS{$key};
    $count++;
    $IDS{$key} = $count . ' ' . $time;
  } else {
    $IDS{$key} = 1 . ' ' . time;
  }

  $text =~ s/\s*\@$twitterid\s*//gi;

  my $content = &processMessage($text);
  if ($content) {
    if ($type eq 'A') {
      my $status = $type . $screen_name . ' ' . $content;
      $bot->update ($status);
    } else {
      $bot->new_direct_message({
        user => $screen_name,
        text => encode("utf8", $content),
      });
    }
  }
}

sub check_new
{
  my $id = $_[0].$_[1]->{'id'};
  my $r = $IDS{$id};
  $IDS{$id} = 1 . ' ' . time;

  ! $r;
}

sub proc_purge
{
  my $tm = time - 2 * 60 * 60; # 2時間でパージ
  while (my ($key, $value) = each %IDS) {
    my ($count, $time) = split /\s+/, $value;
    if ($time && $time < $tm) {
      delete $IDS{$key};
    }
  }

  1;
}

sub proc_reply
{
  my $posts = $bot->replies;
  my @new_posts = reverse grep &check_new('reply', $_), @$posts;

  for my $new_post (@new_posts) {
    &reply (
      '@',
      'A',
      $new_post->{'user'}{'screen_name'},
      $new_post->{'text'}
    );
  }

  @new_posts + 0;
}

sub proc_dm
{
  my $posts = $bot->direct_messages;
  my @new_posts = reverse grep &check_new('dm', $_), @$posts;

  for my $new_post (@new_posts) {
    &reply (
      'D ',
      'A',
      $new_post->{'sender'}{'screen_name'},
      $new_post->{'text'}
    );
  }

  @new_posts + 0;
}

sub InMessage
{
  my $sid = shift;
  my $message = shift;
  my $fromJID = $message->GetFrom("jid");
  my $from = $fromJID->GetJID("full");

  my $body = $message->GetBody();
  print "===\n";
  print "From: $from\n";
  print "ImBody: $body\n";

  if ($from eq 'twitter@twitter.com') {
    if ($body =~ /(\w+):.*\@$twitterid\s*(.*)/i) {
      &reply (
        '@',
        'I',
        $1,
        $2
      );
      $imcount++;
    } elsif ($body =~ /Direct from (\w+):.*\n(.*)/i) {
      &reply (
        'D ',
        'I',
        $1,
        $2
      );
      $imcount++;
    }
  }
}

sub proc_jabber
{
  $imcount = 0;
  $Connection->Process(1);

  $imcount;
}

my $tm = time;
my @ttable = (
  {
    name => 'reply',
    func => \&proc_reply,
    time => $tm + 60,
    inter => 120,
  },
  {
    name => 'dm',
    func => \&proc_dm,
    time => $tm,
    inter => 120,
  },
  {
    name => 'jabber',
    func => \&proc_jabber,
    time => $tm,
    inter => 10,
  },
  {
    name => 'purge',
    func => \&proc_purge,
    # 10min遅らせる。replyとdmの処理が終わってから
    # purgeするように余裕を持っておく。
    time => $tm + 10*60,
    inter => 10*60,
  },
);

&init;
&initTwitter;
&initJabber;

while (1) {
  my $tm = time;
  my $cnt;
  foreach (@ttable) {
    if ($_->{time} <= $tm) {
      my $fn = $_->{func};
      $cnt += &$fn;
      $_->{time} += $_->{inter};
      last if ($cnt);
    }
  }
  sleep(10);
}
exit(0);

sub Stop
{
  print "Exiting...\n";
  undef $db;
  untie(%IDS);

  $Connection->Disconnect();

  exit(0);
}

残務

Jabberで送信元を偽装されるとスパムボットになってしまいます。ちょっと考えないといけないかも。

ダイスロールの指定も四則演算くらいは必要かもしれません。足し算と引き算だけでよければ簡単なんだけどな。