設置の容易さを考えて、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; }