はてなブックマークリニューアルで削除されたはてな投げ銭機能をはてなブックマークWeb Hookを使って復活(ある意味以前よりも強力に)
スポンサードリンク
(2013-3-12 16:45 追記)
2013年2月はてなポイント送信システム改変に対応したものを
http://cl.hatenablog.com/entry/hatenabookmark_webhook_nagesen_004
で用意してあります。
~~~
はてなブックマークのリニューアルにあわせて、はてな投げ銭機能がなくなってしまったのに気づいている人はどれだけいるでしょうか。
はてな投げ銭機能っていうのは
ブログ作者に投げ銭を - jkondoの日記 [d.hatena.ne.jp]
にて実装された「お気に入りのエントリを書いた人に対してはてなポイントを送信する仕組み」です。がんばって書いたブログのエントリに対し、報酬が支払われるとモチベーションがあがったりするよね、ということだと思います。
この機能の実装によって、エントリに作者のはてなIDが埋め込まれていれば、ブックマーク時に投げ銭をするかしないか選べるというものでした。
さて、なんでか知らんけど実装から3年半ぐらいではてなブックマークの投げ銭機能がなくなってしまい、そのあと、
ドネーションのご案内 - 名もないテクノ手 [d.hatena.ne.jp]
現在、わたしが「Show Time +one」「名もないテクノ手」などで個人的に公開してるスクリプトの使用や各種情報に対して、金銭的な対価を支払う必要はありません。その方針は今後とも変わりません。たぶん。
だがしかし。開発やメンテナンスにかかる手間と時間。参考書籍や機器、ソフトウエアの購入。さらにサイト運営費などはすべて個人の持ち出しになっています。こうした「清廉潔白さ」はわたしの好感度をますますアップさせますが、現状はかなり汲々としています。たまにちょっと疲れちゃうのです。ときどき回っていないお寿司も食べたいんです。
ということで、せうぞー活動に対してなんらかの援助をする各種方法を書いておきます。こころおきなくご利用くださいませ。
と書いておられるのを見て、やっぱりはてな投げ銭機能は外すべきじゃあ無かったと思った次第。そういうわけで、先日リリースされたはてなブックマーク Web Hook [hatena.g.hatena.ne.jp] を使い、ブックマークしたら問答無用で投げ銭する仕組みを作りました。
filename: throw.cgi
#!/usr/bin/perl
# throw.cgi ブックマークしたら投げ銭します。
# 2009-06-07 ver 0.0.1 ファーストポスト
use strict;
use warnings;
use CGI;
use Config::Pit;
use Encode;
use HTML::AccountAutoDiscovery;
use utf8;
use WWW::Mechanize;
# 初期設定
my $url_sendpoint = 'https://www.hatena.ne.jp/sendpoint';
my $send_point = 10; # 送信するポイント(はてな手数料別)
my $login;
my $config = pit_get('hatena.ne.jp');
die "not preset account data in Pit." if !%$config;
my $my_id = $config->{id } or die 'id not found.';
my $password = $config->{password} or die 'password not found.';
my $auth_key = $config->{auth_key} or die 'auth_key not found.';
my $q = CGI->new;
my $mech = WWW::Mechanize->new;
$mech->agent_alias('Windows IE 6');
{ # メインルーチン
# 認証
if ( $q->param('key') ne $auth_key ) {
die "Authentication failed";
}
# メソッド確認
if ( $q->param('status') eq 'add' ) {
# エントリーの情報
my $req = $q->Vars();
nagesen( $req );
}
# はてなブックマークWeb HOOK用リザルト
print $q->header('text/plain');
print 'ok';
}
exit;
sub nagesen {
my $req = shift;
my $url = $req->{url};
my @account = HTML::AccountAutoDiscovery->find( $url );
foreach my $item ( @account ) {
my $send_id = $item->{account}; # account name
send_hatenapoint( $req, $send_id );
last; # HTMLに複数のIDを埋め込んでいた場合最初の人の分
# だけ対応(同じ人がID埋め込みまくるとポイント
# 送信しまくるのを防ぐ)
}
return;
}
sub login_hatenapoint {
# はてなにログインします
$mech->get( $url_sendpoint );
# ログインを促す画面に遷移済
$mech->follow_link( text => encode( 'utf8', 'ログイン') );
# ログイン画面に遷移済
$mech->set_visible( $my_id, $password );
$mech->submit();
# ログイン済み画面に遷移済
$mech->follow_link( text => encode('utf8', 'こちら') );
# 投げ銭画面に遷移済
$login = 1;
return;
}
sub send_hatenapoint {
# はてなポイント送信をします
my $req = shift;
my $send_id = shift;
unless ( $login ) {
login_hatenapoint();
}
# ログイン済みの状態
$mech->get( $url_sendpoint );
# はてなポイント送信のページに遷移済
# ポイント送信メッセージ組み立て
my $send_message = decode('utf8', $req->{title})
."($req->{url}) をブックマークしました。投げ銭いたします。"
.'投げ銭スクリプト:http://svn.coderepos.org/share/lang/'
.'perl/misc/hatenabookmark_webhook_nagesen/';
# ポイント送信用パラメータ入力
$mech->set_visible(
$password, $send_id, $send_point,
undef, # 匿名にしたい場合は1
encode('utf8', $send_message )
);
$mech->submit();
# confirm画面に遷移済
return unless $mech->title() eq encode('utf8',
'はてな ポイント付きメッセージ送信確認'); # 送信確認ページ?
$mech->click_button( value => encode('utf8', '送信する') );
#open my $fh, '>', 'log.html';
#print $fh $mech->content();
#close $fh;
return;
}
config::pitではてなのID、パスワード、Web Hookを使うためのkeyの設定が必要です。
CodeRepos: http://svn.coderepos.org/share/lang/perl/misc/hatenabookmark_webhook_nagesen/
作ってみてわかったんですが、はてなの豊富なAPIのなかに投げ銭関連のが見当たらなかった。しょうがないので、WWW::Mechanizeでブラウザ操作をエミュレートすることになりました。なんで投げ銭APIないのかな。
今回はお金に絡むスクリプトです。僕は全く責任を負わないので、使用者は充分理解した上で使ってみてください。
(2009-6-7 19:48追記)
僕は積極的な投げ銭派でして、
M.C.P.C.: はてな投げ銭機能で年間1500はてなポイント使った
という感じで投げ銭していました。
スポンサードリンク
トラックバック(0)
トラックバックURL: http://blog.dtpwiki.jp/MTOS/mt-tb.cgi/2874





![: Amazon.co.jp: プラスティック・メモリーズ 1【完全生産限定版】(イベントチケット優先販売申込券付) [Blu-ray]](/lists/_9/B00VWX66E8.jpg)
![: Amazon.co.jp: プラスティック・メモリーズ 2【完全生産限定版】[Blu-ray]](/lists/_9/B00VWX66K2.jpg)
![: Amazon.co.jp: プラスティック・メモリーズ 3【完全生産限定版】[Blu-ray]](/lists/_9/B00VWX6MV0.jpg)
![: Amazon.co.jp: プラスティック・メモリーズ 4【完全生産限定版】[Blu-ray]](/lists/_9/B00VWX66IO.jpg)
![: Amazon.co.jp: プラスティック・メモリーズ 5【完全生産限定版】[Blu-ray]](/lists/_9/B00VWX6Y0E.jpg)
![: Amazon.co.jp: プラスティック・メモリーズ 6【完全生産限定版】[Blu-ray]](/lists/_9/B00VWX69D6.jpg)


複数アカウントの最初だけ処理するなら、List::Utilのfirstを使って
my $send_id = first { defined($_->{account}) } @account;
send_hatenapoint( $req, $send_id );
のほうが「ループして処理してlastで抜ける」よりも「最初のだけ処理する」って分かりやすいかも。
List::Utilは知らなかったのでやってみました。
defined内で$_->{account}指定しても出てこなかったんで
外でやってます。
use List::Util qw(first); my @account = ( { account =>'C_L1', service => 'http://www.hatena.ne.jp/' }, { account =>'C_L2', service => 'http://www.hatena.ne.jp/' }, { account =>'C_L3', service => 'http://www.hatena.ne.jp/' }, ); my $send_id = first { defined($_) } @account; print "$send_id->{account}\n" if $send_id;今回僕が作ったのは、Account Auto-Discoveryでは複数人を列挙できるようになっているので、当初複数人に投げ銭できるように作ってみたのですが、1回に定額投げ銭するスクリプトと勘違いして設置した人に対しては意図しない動作になると考えて、あとからlastをいれました。
lastをコメントアウトすれば、当初の動作にも変更できるからいいかなーと思っています。