イラレが落ちた.biz

このTwitter bot・このサイトについて

Twitterの検索を使い、「イラレが落ちた」で検索します。
@付き、リツイート、「イラレが落ちたbot」（言及するときにこう書かれることが多いです）、「イラレが落ちた (@illustrator_orz)」（アカウント紹介などでこう書かれることが多いです）は無視します。
「イラレ落ちた」「Illustratorが落ちた」など表記の揺れは、Twitter Search API仕様に依存します（開始時より表記ゆれも検索結果として採用されるように改善されてきています）。
Twitter botが本日何人目かをカウントしてつぶやきます。
Twitter botのアカウントは @Illustraor_orzです。
ウェブサイト http://イラレが落ちた.biz/ では集計しグラフにします。
2013/6/7から稼働開始しました。
アドビに直接要望を伝える場合は、Illustrator の品質向上に向けた機能要望アンケート一覧が便利です。

アドビシステムズ社へのボットアクセス・アドビシステム社関連Twitterアカウントに向けたツイートについて

毎月1日、先月のIllustratorが落ちた回数を集計して、1件以上あった場合、アドビシステムズ社のTwitterアカウントにツイートします。
アドビシステムズ社に関連したTwitterアカウントを特定するため、ボットが http://www.adobe.com/jp/news-room/social-media.html にアクセスし、自動的にTwitterアカウントの文字列を特定します。
ボットはロボット排除規約（Robots Exclusion Standard）のDisallowディレクティブに従いアクセスを制御します。ボットのUAは 'iraregaochita.biz/0.1 (+http://xn--v8jvbf0y0lsa8140m.biz/development)' です。
ボットのアクセスにより取得できたTwitterアカウントをアドビシステムズ社の利益に供するTwitterアカウントであるとみなし、先月分の「イラレが落ちた」とTwitterでつぶやかれた回数をレポートし、製品改善をやんわりとうながします。
（アドビのサイトにアカウント名が掲載されている以上様々なmentionが飛んでくる覚悟は出来ておられるかと）

ソースコード

設置の容易さを考えて、crontabで1分毎実行しています。

Filename: bot.pl

use strict;
use warnings;
use utf8;
use Config::Pit;
use Date::Parse;
use DateTime;
use DateTime::Format::MySQL;
use DBI;
use Encode;
use File::Spec;
use FindBin::Real;
use Net::Twitter;
use URI::Escape;
use YAML;
binmode STDOUT => ':utf8';

# 多重起動防止

if ($$ != `/usr/bin/pgrep -fo $0`) {
  print STDERR "process running!\n";
  exit 1;
}

# 初期設定

# $max_id: 前回取得した最後のツイートid。0の場合は全検索、
# idセットされている時はそれ以降のツイートが結果表示されます
my $max_id = 0;

# DB作るよ！
my $dbfile = File::Spec->catfile( FindBin::Real::Bin(), '..', 'db', 'dbfile.sqlite');
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", "",
                           { sqlite_unicode => 1, AutoCommit => 0 });
# DBが新規作成だったとき、DBの初期設定をします。
if ( -s $dbfile == 0) {
  $dbh->do('CREATE TABLE orz ( '
            . 'id INTEGER PRIMARY KEY AUTOINCREMENT, '
            . 'id_str                  TEXT, '
            . 'name                    TEXT, '
            . 'screen_name             TEXT, '
            . 'created_at              DATETIME, '
            . 'text                    TEXT, '
            . 'profile_image_url       TEXT, '
            . 'profile_image_url_https TEXT, '
            . 'reply INTEGER);'
  );
  $dbh->do('CREATE TABLE total ( '
             . 'id INTEGER PRIMARY KEY AUTOINCREMENT, '
             . 'date  TEXT, '
             . 'count INTEGER);'
  );
} else { # DBが既存だった時は、$max_idを取得します。
  my $sth  = $dbh->prepare('SELECT * FROM orz ORDER BY rowid DESC LIMIT 1');
  my $res  = $sth->execute();
  my $hash = $sth->fetchrow_hashref;
  $max_id = $hash->{id_str};
}

# botのTwitterアプリ
my $keys = YAML::LoadFile(
  File::Spec->catdir( FindBin::Real::Bin(), '..', 'consumer_keys.yaml' )
);
my $nt  = Net::Twitter->new(
    traits => [qw/API::RESTv1_1 WrapError/],
    consumer_key    => $keys->{consumer_key},
    consumer_secret => $keys->{consumer_key_secret},
    ssl => 1
);
# botのアカウントをセット
my $pit = pit_get( 'twitter.com@Illustrator_orz' );
$nt->access_token       ( $pit->{access_token}        );
$nt->access_token_secret( $pit->{access_token_secret} );

# botのアカウントでキーワード「イラレが落ちた」で検索する。
my $search_term = {
  q    => uri_escape_utf8('イラレが落ちた'),
  lang => 'ja',
  count => 100,
  since_id => $max_id,
};
my $r = $nt->search($search_term);
#print Dump $r;

# 検索結果があった場合
my $last;
if ( $#{$r->{statuses}} > -1 ) {
  my $sth = $dbh->prepare('INSERT INTO orz (id_str, name, screen_name, created_at, '
                              . 'text, profile_image_url, profile_image_url_https ) '
                              . 'VALUES ( ?, ?, ?, ?, ?, ?, ? )') || die $DBI::errstr;
  my %count;
  foreach my $item ( reverse @{$r->{statuses}} ) {
    my $text = $item->{text};
    next if $text =~ m/\@\w/; # @つきツイートは無視します
    next if $text =~ m/イラレが落ちた\s*bot/i; # イラレが落ちたbotに関する言及は無視します
    next if $text =~ m/イラレが落ちた\s\(Illustrator_orz\)/i; # イラレが落ちたbotに関する言及は無視します
    next if $text =~ m/イラレが落ちた\.biz/i; # イラレが落ちた.bizに関する言及は無視します
    next if exists $item->{retweeted_status}; # リツイートは無視します
    my $screen_name = $item->{user}->{screen_name};
    next if $screen_name eq 'CLCLCL';
    next if $screen_name eq 'Illustrator_orz';
    next if $screen_name eq '_flip_your_lid'; # add 2015/2/2
    next if $screen_name eq 'moemoe_tweet';   # add 2015/2/2
    next if $screen_name eq 'yanahara_aki';   # add 2015/3/1
    next if $screen_name eq 'Ogawa_Misae';    # add 2015/3/1
    next if $screen_name eq 'Matsuri_Koume';  # add 2015/3/9
    next if $screen_name eq 'Inukai_Isuke_';  # add 2015/3/9
    next if $screen_name eq 'Ban4149';        # add 2015/5/13
    next if $screen_name eq 'eroge4232';      # add 2015/6/20
    next if $screen_name eq 'UnanimousLolita';# add 2015/7/1
    next if $screen_name eq 'twit_japan';     # add 2015/7/12
    next if $screen_name eq 'yuigon_1110';    # add 2015/7/22
    next if $screen_name eq '_Marie__Rose';   # add 2015/7/22
    next if $screen_name eq 'apprise_of';     # add 2015/7/23
    next if $screen_name eq 'Lady_Sallya';    # add 2015/7/23
    next if $screen_name eq 'KiritaniYukina'; # add 2015/7/23
    my $dt = DateTime->from_epoch( epoch     => str2time( $item->{created_at} ),
                                      time_zone => 'GMT');
    my $dt_mysql = DateTime::Format::MySQL->format_datetime($dt);
    if ( $text =~ m/(\d\d:\d\d)/ ) {
      my $timestr = $1;
      if ( $timestr eq $dt->strftime('%H:%M') ) {
        next; # 本文中に時刻を'12:34'の形式でツイートするSPAMbot対策
      }
      my $dt_clone = $dt->clone();
      $dt_clone->add(minutes => -1);
      if ( $timestr eq $dt_clone->strftime('%H:%M') ) {
        next; # 本文中に時刻を'12:34'の形式でツイートするSPAMbot対策
      }
      $dt_clone = $dt->clone();
      $dt_clone->add(minutes => +1);
      if ( $timestr eq $dt_clone->strftime('%H:%M') ) {
        next; # 本文中に時刻を'12:34'の形式でツイートするSPAMbot対策
      }
    }
    $dt->set_time_zone('Asia/Tokyo');
    print "$item->{id_str} $dt $dt_mysql $text\n";
    $count{$dt->ymd('-')}++;
    my $id_str = $item->{id_str};
    $sth->execute(
      $id_str, $item->{user}->{name},
      $screen_name, $dt_mysql, $text,
      $item->{user}->{profile_image_url},
      $item->{user}->{profile_image_url_https}
    ) || die $DBI::errstr;
    $last = {
      screen_name => $screen_name,
      id_str      => $id_str,
      date        => $dt->ymd('/'),
    };
  }

  my $sum;
  for my $date ( sort keys %count ) {
    $sth = $dbh->prepare('SELECT * FROM total WHERE date = ?');
    my $res = $sth->execute( $date );
    my $hash = $sth->fetchrow_hashref;
    unless ( exists $hash->{count} ) {
      $sth = $dbh->prepare('INSERT INTO total ( date, count ) VALUES (?, ?)');
      $sum = $count{$date};
      $sth->execute( $date, $sum );
    }
    else {
      $sum = $hash->{count};
      $sum += $count{$date};
      $sth = $dbh->prepare('UPDATE total SET count = ? WHERE date = ?');
      my $res = $sth->execute( $sum, $date );
    }
  }
  $dbh->commit();

  if ( $sum ) {
    $last->{sum} = $sum;
    my $status = make_message( $last );
    print "$status\n";
    my $res = $nt->update($status);
  }
}
else {
  $dbh->commit();
}
exit;


sub make_message {
  $last = shift;
  my $dic = [];
  $dic->[0] = '本日(${date})、${sum}人目のイラレが落ちたようです。 ${post_url}';
  $dic->[3] = 'たぶんあなたは……3人目……だと思うから……。'
            . '（${date}にイラレが落ちた人累計） ${post_url}';
  $last->{post_url}
    = "https://twitter.com/$last->{screen_name}/status/$last->{id_str}";
  my $sum = $last->{sum};
  my $str = $dic->[0];
  if ( $dic->[$sum] ) {
    $str = $dic->[$sum];
  }
  # 2015-04-24 24HOUR ILLUSTRATOR 開催時にハッシュタグ #24h_ai を付ける
  my $dt = DateTime->now()->set_time_zone('Asia/Tokyo');
  my $p = sub { return DateTime::Format::MySQL->parse_datetime(shift); };
  if (( $p->('2015-04-24 12:00:00') <= $dt ) && ( $dt < $p->('2015-04-25 12:00:00')) ) {
    $str .= ' #24h_ai';
  }
  # 2015-06-05 世界環境デー Adobe 7ドルドネート企画用
  # https://twitter.com/AdobeJapan/status/606384326469517312
  if (( $p->('2015-06-05 00:00:00') <= $dt ) && ( $dt < $p->('2015-06-06 00:00:00')) ) {
    $str .= ' イラレが落ちない世界が私たちの夢です。#CreateChange @AdobeDocCloud';
  }
  
  my @a = $str =~ m/\$\{\w+\}/g;
  foreach my $item ( @a ) {
    my $x = $item;
    $x =~ s/[^\w]+//g;
    my $t = $item;
    $t =~ s/\$/\\\$/;
    $t =~ s/\{/\\\{/;
    $t =~ s/\}/\\\}/;
    my $regex = qr/$t/;
    $str =~ s/$regex/$last->{$x}/e;
  }
  return  $str;
}