2009-03-15
お天気を教えてくれるbot作ったよ!
cronで何かする練習で、botを書いてみた。
凄くつまらないです。
そこはもう分かってるからツッコまないでいただきたい…。
#!/usr/bin/perl -w use strict; use utf8; use Dumpvalue; use XML::Simple; use LWP::UserAgent; use Net::Twitter; use MeCab; use Encode qw/encode/; my $ua = LWP::UserAgent->new(); my $tw = Net::Twitter->new({ username => 'id', password => 'pass' }); my $mc = MeCab::Tagger->new(); my $wt = prefecture_ids(); my $si = since_id(); my $fi = 1; # Get follow messages my $follow_msgs = $tw->search('@botrin1024', { since_id => $si })->{results}; foreach my $msg(@$follow_msgs) { my $city; my $game; my $mode; #= sub { if($msg->{text} =~ /\*([\w_]*)/) { return $1; } }->(); # get since_id if ($fi) { $si = $msg->{id}; $fi = 0; } # remove follower_id $msg->{text} =~ s/\@[\w_]*//; # morphological analysis for(my $node = $mc->parseToNode($msg->{text});$node;$node = $node->{next} ) { next unless defined $node->{surface}; my($speech, $con, $type, $pron) = (split(/,/, $node->{feature}))[0,1,2,7]; #next if $speech ne encode('utf8', '名詞'); if ($node->{surface} eq encode('utf8', '天気')) { $mode = 'weather'; } elsif ($con eq encode('utf8', '固有名詞') && $type eq encode('utf8', 'ゲーム名')) { $game = $node->{surface}; } elsif ($con eq encode('utf8', '固有名詞') && $type eq encode('utf8', '地域')) { $city = $node->{surface}; } #print $node->{surface}, "\t", $pron, "\t", $speech, "\t", $type, "\n"; } # execute mode if ($mode eq 'weather') { my $text = '@' . $msg->{from_user} . ' ' . get_weather($city); $tw->update({ status => $text }); } else { # die(''); } # option mode if (length $game) { my $text = '@' . $msg->{from_user} . ' '. $game . encode('utf8', 'をやりたいんですね、わかります。'); $tw->update({ status => $text }); } print "ok.\n"; } # set since_id since_id($si); # rand echo $tw->update({ status => encode('utf8', '"' . get_keyword() . '"とかで検索してみるとオモロいかも?') }); ## Get since_id sub since_id { my $since_id = shift; if ($since_id) { open my $FILE, '>', '/home/yuki/projects/bot/since_id.txt'; print $FILE $since_id, "\n"; close $FILE; } else { open my $FILE, '<', '/home/yuki/projects/bot/since_id.txt'; $since_id = <$FILE>; close $FILE; } return $since_id; } ## Get prefecture ids sub prefecture_ids { open my $FILE, '<', '/home/yuki/projects/bot/forecastmap.xml'; my @ids = <$FILE>; close $FILE; return XMLin(join '', @ids)->{prefectures}; } ## Get weather data sub get_weather { my $city_name = shift; my $text = q{}; my $city_id; while(my($key,$val) = each(%{$wt->{city}})) { if ($val->{title} eq $city_name) { $city_id = $key; last; } } if ($city_id) { my $w_url = 'http://weather.livedoor.com/forecast/webservice/rest/v1?city='.$city_id.'&day=tomorrow'; my $weather = XMLin($ua->simple_request( HTTP::Request->new('GET', $w_url) )->content); $text .= $weather->{location}->{pref}.'の天気は、'.$weather->{telop}.'だそうです。'.$/; $text .= $weather->{description}.$/; # $text .= '詳しくは、'.$weather->{link}.'を見てね'.$/; } else { $text = "ゴメン!ちょっとよくわかんない!!"; } return encode('utf8', $text); } ## Get from sagool api sub get_keyword { my $sagool = XMLin($ua->simple_request( HTTP::Request->new('GET', 'http://sagool.jp/wacaalapi?type=xml') )->content)->{channel}->{item}; return $sagool->[0]->{title}; } 1;
$ crontab -l
・作った経緯
http://www.team-lab.com/news/index.php?itemid=469
こんなのやってたから。
・使い方
こいつに県名と「天気教えてー」って見たいな事言うと教えてくれる。
5分おき位に返事くれるよ。
エロゲのタイトルが本文にあると何か言うよ。
独り言ではさぐーるの最近検索されたワードの紹介するよ。
・反省点
encode一杯使わないで、XMLファイルの方をdecodeした方が絶対楽そう。
普通すぎて正直つまんない。
each文が何か良い子じゃないからdumpvalueで1回表示してやり直してる(これ可笑しい)。
→途中でreturnとかやってたからアカンかった。ちゃんと代入してlast使えばok。
・ホントにやりたかったこと
エロゲのタイトル書くとツンツンしながら色々調べてくれるの。
辞書までは作った(Wiki使って) → http://sorauta.net/files/EroDic.csv
・ふとよく考えてみると
独自アルゴリズムなんて部分これっぽっちもないよね。
\(^o^)/
・8/29追記
utf8フラグonにしてたらエラー出てたので今更だけど,修正した.
参考:http://floralcompany.jp/archives/2009/08/workaround_for.html
コメントを書く
トラックバック - http://d.hatena.ne.jp/rin1024/20090315/1237134662
リンク元
- 5 http://www.google.co.jp/search?sourceid=navclient&hl=ja&ie=UTF-8&rls=GGLG,GGLG:2008-29,GGLG:ja&q=firefox3 落ちる
- 4 http://twitter.gooolegle.com/
- 3 http://www.google.co.jp/search?hl=ja&q=このユーザーは+SQL+Server+の信頼関係接続と関連付けられて??
- 2 http://d.hatena.ne.jp/allspice/20080301
- 2 http://search.minakoe.jp/rsss/rsss.asp?qry=domain:hatena+perl&multi=1
- 2 http://www.google.co.jp/search?hl=ja&client=firefox-a&rls=org.mozilla:ja:official&hs=02p&q=firefox3+落ちる&btnG=検索&lr=lang_ja
- 2 http://www.google.com/search?hl=ja&lr=lang_ja&ie=UTF-8&oe=UTF-8&q=mount+error+13+=+Permission+denied&num=50
- 2 http://www.google.com/search?hl=ja&num=50&q=linux windows apache 共有&lr=lang_ja
- 1 http://72.14.235.132/search?q=cache:75agvXn1z9sJ:d.hatena.ne.jp/rin1024/20081121/1227294273+.bash_profile+ 読込&cd=3&hl=ja&ct=clnk&gl=jp&lr=lang_ja
- 1 http://b.hatena.ne.jp/entry/http://www.team-lab.com/news/index.php?itemid=469
