様々なオンラインブックマークサービスのブックマーク件数を画像ではなくて数値で取得（高機能版）

ココログでも書いたんだけど（http://blog.dtpwiki.jp/dtp/2008/03/post_88ba.html）、はてなダイアリーのスーパーpre記法つかうとキレーに表示されそうなんでこっちに書いてみるよ。

長ったらしいプログラムだけども、一つのCGIにいろいろ詰め込んだのでしょうがないのです。

動作確認は、http://labo.dtpwiki.jp/sbm/ でどーぞ。

問題はSBMサービスへの問い合わせが非同期になっていないことかな。livedoorがこけると皆こける。そんでdocument.writeでブログパーツを表示していると、そこで固まってしまうという寸法だ。Perlで問い合わせ非同期するのどうすればいいんだろう。POEてやつかなー

画像でUser数取れるblogサービスあったら教えてください。リダイレクト先のイメージのパスから数字を抜き出すなんてことしていますゆえ。

とりあえず、印刷・製本SNSのコミュニティに投げました。ブログパーツとして使ってもらおうかなーと思っているんだけど…

#!/usr/bin/perl
use strict;
use warnings;
use Cache::File;
use CGI;
use Digest::MD5;
use HTML::Template;
use JSON::Syck;
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Date;
use utf8;
use Data::Dumper;
use XMLRPC::Lite;
binmode STDOUT => ':utf8';
 
sbm();
 
sub sbm {
  # 初期設定
  our $cachedir = 'cache';
  our $sbms = { 
       hatena =>
       {
         proxy   => 'http://b.hatena.ne.jp/xmlrpc',
         entry   => 'http://b.hatena.ne.jp/entry/',
         method  => 'bookmark.getCount',
         message => 'このエントリーをはてなブックマークで'
                   .'ブックマークしているユーザ数',
       },
       livedoor =>
       {
         proxy   => 'http://rpc.clip.livedoor.com/count',
         entry   => 'http://clip.livedoor.com/page/',
         method  => 'clip.getCount',
         message => 'このエントリーを'
                   .'livedoor Clipでクリップしているユーザ数',
       },
       pingking =>
       {
         proxy   => 'http://api.pingking.jp/xmlrpc/bookmark',
         entry   => 'http://pingking.jp/url/',
         method  => 'getCount',
         message => 'このエントリーを'
                   .'PingKingでブックマークしているユーザ数',
       },
       yahoo =>
       {
         proxy   => 'http://num.bookmarks.yahoo.co.jp/yjnostb.php?urls=',
         regexp  => 'ct="(\d+)"',
         entry   => 'http://bookmarks.yahoo.co.jp/url?url=',
         message => 'このエントリーを'
                   .'Yahooブックマークしているユーザ数',
       },
       delicious =>
       {
         proxy   => 'http://badges.del.icio.us/feeds/json/url/data?url=',
         entry   => 'http://del.icio.us/url/',
         message => 'このエントリーを'
                   .'del.icio.usでブックマークしているユーザ数',
       },
       buzzurl =>
       {
         proxy   => 'http://api.buzzurl.jp/api/counter/v1/json?url=',
         entry   => 'http://buzzurl.jp/entry/',
         message => 'このエントリーを'
                   .'Buzzurlでブックマークしているユーザ数',
       },
       fc2 =>
       {
         proxy   => 'http://bookmark.fc2.com/image/users/',
         regexp  => '/(\d+)\.png',
         entry   => 'http://bookmark.fc2.com/search/detail?url=',
         message => 'このエントリーを'
                   .'FC2ブックマークしているユーザ数',
       },
       pookmark =>
       {
         proxy   => 'http://pookmark.jp/count/',
         regexp  => '/(\d+)$',
         entry   => 'http://pookmark.jp/url/',
         message => 'このエントリーを'
                   .'POOKMARKでブックマークしているユーザ数',
       },
       total =>
       {
         entry   => 'http://labo.dtpwiki.jp/sbm/check.cgi?url=',
         message => 'このエントリーをブックマークしている'
                   .'総ユーザ数',
       }
     };
  
  
  # 開始
  my $q      = CGI->new();
  my $url    = $q->param('url') || 'http://www.yahoo.co.jp/';
  
  # キャッシュ
  my $data   = check_cache( $url );
  my $counts = $data->{counts};
  my $expiry = $data->{expiry};
  my $ctime  = $data->{ctime};
  
  # ブラウザキャッシュと比較
  if ( $q->http('If-Modified-Since') eq time2str($ctime) ) {
    print $q->header(
       -status         => '304 Not Modified',
       'Cache-Control' => "max-age=$expiry",
    );
  }
  elsif ( $q->param('mode') ) {
    if ( $q->param('mode') =~ m|json|i ) {  # JSON出力モード
      show_json( $q, $url, $counts, $expiry, $ctime );
    }
    elsif ( $q->param('mode') =~ m|js|i ) { # js出力モード
      show_js( $q, $url, $counts, $expiry, $ctime );
    }
  }
  else { # モード指定なし：HTML出力モード
    show_html( $q, $url, $counts, $expiry, $ctime );
  }
  exit; # ｵﾜﾀ
  
  
  # JS出力モード
  sub show_js {
    my $q      = shift;
    my $url    = shift;
    my $counts = shift;
    my $expiry = shift;
    my $ctime  = shift;
    print $q->header(
      -type    => 'text/javascript',
      -charset => 'UTF-8',
      -expires => "+${expiry}",
      "Last-modified" => time2str($ctime),
    );
    my $tmpl_html = <<"    END_OF_JS";
      document.write( ''
        + '<img src="http://labo.dtpwiki.jp/'
        + 'sbm/images/total.gif"'
        + ' width="16" height="16" border="0"'
        + ' style="vertical-align: middle;" />'
        + '<tmpl_var name="users">'
      );
    END_OF_JS
    my $tmpl = HTML::Template->new( scalarref => \$tmpl_html );
    (my $users = sbm_html('total', $url, $counts->{total} ) )
      =~ s|[\x0a\x0d]||g;
    $users =~ s|\s\s+| |g;
    $tmpl->param( users => $users );
    print $tmpl->output();
    return;
  }
  
  # JSON出力モード
  sub show_json {
    my $q      = shift;
    my $url    = shift;
    my $counts = shift;
    my $expiry = shift;
    my $ctime  = shift;
    my $json   = $q->param( 'callback' ) =~ m/^[a-zA-Z0-9\.\_\[\]]+$/
                   ? $q->param( 'callback' )
                     . '(' . JSON::Syck::Dump( $counts ) . ');'
                   : JSON::Syck::Dump( $counts );
    print $q->header(
      -type           => 'text/javascript',
      -expires        => "+${expiry}",
      "Last-modified" => time2str($ctime),
    );
    print $json;
  }
  
  # HTML出力モード
  sub show_html {
    my $q      = shift;
    my $url    = shift;
    my $counts = shift;
    my $expiry = shift;
    my $ctime  = shift;
    my $html_hash = { # テンプレート差し込み用HTML項目準備
      yahoo     => sbm_html( 'yahoo'    , $url, $counts->{yahoo    } ),
      hatena    => sbm_html( 'hatena'   , $url, $counts->{hatena   } ),
      delicious => sbm_html( 'delicious', $url, $counts->{delicious} ),
      fc2       => sbm_html( 'fc2'      , $url, $counts->{fc2      } ),
      livedoor  => sbm_html( 'livedoor' , $url, $counts->{livedoor } ),
      pookmark  => sbm_html( 'pookmark' , $url, $counts->{pookmark } ),
      buzzurl   => sbm_html( 'buzzurl'  , $url, $counts->{buzzurl  } ),
      pingking  => sbm_html( 'pingking' , $url, $counts->{pingking } ),
      total     => sbm_html( 'total'    , $url, $counts->{total    } ),
      url       => $url,
    };
    my $tmpl_html = << '    END_OF_HTML';
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC 
  "-//W3C//DTD XHTML 1.0 Strict//EN"
  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml"
  xml:lang="ja" lang="ja">
  <head>
    <meta http-equiv="Content-Type"
      content="text/html; charset=UTF-8" />
    <title>
      各SBMサービス別オンラインブックマーク件数チェック
    </title>
    <meta http-equiv="content-style-type"
      content="text/css" />
    <link rev="made" href="mailto:aab61120@pop12.odn.ne.jp" />
    <link rel="index" href="." />
    <style type="text/css">
      body {
        font-size: 13px;
        *font-size: small;
        *font: x-small;
      }
      * {
        margin: 0; 
        padding: 0;
        line-height: 1.6;
        color: #333;
      }
      body {
        background-color: #fff;
        font-family: 'メイリオ',Meiryo,
                     'ＭＳ Ｐゴシック',sans-serif;
      }
      input {
        font-family: Osaka, 'メイリオ',Meiryo,
                     'ＭＳ Ｐゴシック',sans-serif;
      }
      h1 {
        font-weight: bold;
        font-size: 122%;
        margin-bottom: 20px;
      }
      img {
        border: 0;
        vertical-align: middle;
      }
      .posted em {
        background-color: #fff0f0;
        font-weight: bold;
        font-style: normal;
      }
      .posted em a,
      .posted em a:link,
      .posted em a:visited,
      .posted em a:hover,
      .posted em a:active {
        color: #f66; 
        font-weight: bold;
        font-style: normal;
      }
      .posted strong {
        background-color: #fcc;
        font-weight: bold;
        font-style: normal;
        display: inline;
      }
      .posted strong a,
      .posted strong a:link,
      .posted strong a:visited,
      .posted strong a:hover,
      .posted strong a:active {
        color: red;
        font-weight: bold;
        font-style: normal;
        text-decoration: none;
      }
      .posted a,
      .posted a:link,
      .posted a:visited,
      .posted a:hover,
      .posted a:active {
        text-decoration: none;
        color: blue;
      }
      #content {
        margin: 20px;
      }
      div.posted {
        margin  : 20px;
        font-size: 90%;
        line-height: 19px;
      }
      dt {
        font-weight: bold;
      }
      dd {
        padding-left: 16px;
      }
    </style>
  </head>
  <body>
    <div id="content">
      <h1>
        <a href="./">
          オンラインブックマーク件数チェック</a
        >
      </h1>
      <form action="check.cgi" method="get">
        <p>
          <label for="url">アドレス：</label>
          <input name="url" id="url" style="width: 60%;"
            tabindex="1" accesskey="a"
            value="<tmpl_var name="url" escape="html">" />
          <input type="submit"
            tabindex="2" accesskey="s"
            value="一斉問い合わせ開始"
          />
        </p>
        <div class="posted">
          <img src="images/yahoo.gif"
            alt="yahoo"
            width="16" height="16"
          /><tmpl_var name="yahoo">
          <br />
          <img src="images/hatena.gif"
            alt="hatena"
            width="16" height="16"
          /><tmpl_var name="hatena">
          <br />
          <img src="images/delicious.gif"
            alt="delicious"
            width="16" height="16"
          /><tmpl_var name="delicious">
          <br />
          <img src="images/fc2.gif"
            alt="fc2"
            width="16" height="16"
          /><tmpl_var name="fc2">
          <br />
          <img src="images/livedoor.gif"
            alt="livedoor"
            width="16" height="16"
          /><tmpl_var name="livedoor">
          <br />
          <img src="images/pookmark.gif"
            alt="pookmark"
            width="16" height="16"
          /><tmpl_var name="pookmark">
          <br />
          <img src="images/buzzurl.gif"
            alt="buzzurl"
            width="16" height="16"
          /><tmpl_var name="buzzurl">
          <br />
          <img src="images/pingking.gif"
            alt="pingking"
            width="16" height="16"
          /><tmpl_var name="pingking">
          <hr />
          <img src="images/total.gif"
            alt="total"
            width="16" height="16"
          /><tmpl_var name="total">
        </div>
      </form>
      <hr />
      <p>
        <a href="http://blog.dtpwiki.jp/dtp/2008/03/post_88ba.html"
          target="_blank">ソースプログラムはこちら</a>
      </p>
      <dl>
        <dt>JSON/JSONP</dt>
        <dd>
          <a href="check.cgi?mode=json&callback=jsonp.callback&url=<tmpl_var
          name="url" escape="html">" target="_blank">
          check.cgi?mode=json&callback=jsonp.callback&url=<tmpl_var
            name="url" escape="html"></a></dd>
        <dt>JavaScript(document.write)</dt>
        <dd>
          <a href="check.cgi?mode=js&url=<tmpl_var
          name="url" escape="html">" target="_blank">
            check.cgi?mode=js&url=<tmpl_var
            name="url" escape="html"></a></dd>
      </dl>
    </div>
  </body>
</html>
    END_OF_HTML
    my $tmpl = HTML::Template->new( scalarref => \$tmpl_html );
    $tmpl->param( $html_hash );
    print $q -> header(
      -type    => 'text/html',
      -charset => 'utf-8',
      -expires => "+${expiry}",
      "Last-modified" => time2str($ctime),
    );
    print $tmpl->output();
    return;
  }
  
  # SBMサービスからブックマーク件数取得
  sub get_sbm {
    my $service = shift;
    my $url     = shift;
    if ( $service eq 'yahoo' ) {
      return get_sbm_yahoo( $url );
    }
    elsif ( $service eq 'delicious' ) {
      return get_sbm_delicious( $url );
    }
    elsif ( $service eq 'buzzurl' ) {
      return get_sbm_buzzurl( $url );
    }
    elsif ( ( $service eq 'fc2' )
         || ( $service eq 'pookmark' ) ) {
      return get_sbm_imageicon( $service, $url );
    }
    else {
      return get_sbm_xmlrpc( $service, $url );
    }
  }
  
  # XMLRPCによるブックマーク件数取得
  #（livedoor,hatena,pingking）
  sub get_sbm_xmlrpc {
    our $sbms;
    my $service = shift;
    my $url     = shift;
    my $result  = XMLRPC::Lite->proxy(
                    $sbms->{$service}->{proxy},
                    timeout  => 5,
                    on_fault => sub { 
                      warn "Timeout $service";
                      return 0;
                    },
       )->call( $sbms->{$service}->{method}, $url )
        ->result || die $service,$!;
    if ( $service eq 'pingking' ) {
      return $result->[0]->{ count };
    } else {
      return $result->{ $url } || 0;
    }
  }
  
  # Yahooブックマーク件数取得(REST)
  sub get_sbm_yahoo {
    our $sbms;
    my $url = shift;
    my $content = get( $sbms->{yahoo}->{proxy}.$url );
    my $count = 0;
    if ( $content =~ m|$sbms->{yahoo}->{regexp}| ) {
      $count = $1;
    }
    return $count;
  }
  
  # del.icio.usブックマーク件数
  sub get_sbm_delicious {
    my $url = shift;
    my $data
      = JSON::Syck::Load(
          get( $sbms->{delicious}->{proxy}.$url )
        );
    return $data->[0]->{total_posts} || 0;
  }
  
  # Buzzurlブックマーク件数
  sub get_sbm_buzzurl {
    my $url = shift;
    my $data
      = JSON::Syck::Load(
          get( $sbms->{buzzurl}->{proxy}.$url )
        );
    return $data->[0]->{users} || 0;
  }
  
  # ブックマーク件数イメージ提供サービスから件数取得
  sub get_sbm_imageicon {
    my $servce = shift;
    my $url    = shift;
    my $ua = LWP::UserAgent->new();
    $ua->agent('Mozilla/4.0 (compatible; '
              .'MSIE 6.0; Windows NT 5.1)'
    );
    my $req = HTTP::Request->new(
                'GET',
                $sbms->{$servce}->{proxy}.$url
              );
    my $res = $ua->simple_request($req);
    my $location = $res->header('location');;
    my $count = 0;
    if ( $location =~ m|$sbms->{$servce}->{regexp}| ) {
      $count = 0 + $1;
    }
    return $count;
  }
  
  # ブックマーク User数 HTML生成
  sub sbm_html {
    my $service = shift;
    my $url     = shift;
    my $count   = shift;
    
    my $tag;
    my $users = 'users';
    $users = 'user'   if $count == 1;
    $tag   = 'em'     if $count > 2;
    $tag   = 'strong' if $count > 9;
    my $tag_s = $tag ? "<$tag>" : q();
    my $tag_e = $tag ? "</$tag>": q();
    
    if ( $service eq 'delicious' ) { # del.icio.usの場合
      my $ctx = Digest::MD5->new;
      $ctx->add( $url );
      $url = $ctx->hexdigest; # del.icio.us用MD5生成
    }
    my $tmpl_html = << '    END_OF_HTML';
          
          <tmpl_var name="tag_s">
          <a href="<tmpl_var name="entry"><tmpl_var
            name="url" escape="html">"
            title="<tmpl_var name="message">"
            rel="nofollow" target="_blank">
            <tmpl_var name="count"> <tmpl_var name="users"></a
          ><tmpl_var name="tag_e">
    END_OF_HTML
    
    my $tmpl = HTML::Template->new( scalarref => \$tmpl_html);
    $tmpl->param(
      url     => $url,
      entry   => $sbms->{$service}->{entry},
      message => $sbms->{$service}->{message},
      tag_s   => $tag_s,
      tag_e   => $tag_e,
      count   => $count,
      users   => $users,
    );  
    
    return $tmpl->output();
  }
  
  # キャッシュ問い合わせ
  sub check_cache {
    our $cachedir;
    my $url = shift;
    my $data;
    my $cache = Cache::File->new( 
      cache_root      => $cachedir,
      default_expires => '3600 sec',
    );
    if ( $cache->exists( $url ) ) { # キャッシュ生きてる？
      $data = $cache->thaw( $url );
      $data->{expiry}  = $cache->expiry($url) - time();
      return $data;
    }
    else {                          # キャッシュ無効？
      my $expiry = 50 + int( rand( 50 ) ).'min';
      my $counts = { # SBMサービスからブックマーク件数取得
        yahoo     => get_sbm( 'yahoo',    $url ),
        hatena    => get_sbm( 'hatena',   $url ),
        delicious => get_sbm( 'delicious',$url ),
        fc2       => get_sbm( 'fc2',      $url ),
        livedoor  => get_sbm( 'livedoor', $url ),
        pookmark  => get_sbm( 'pookmark', $url ),
        buzzurl   => get_sbm( 'buzzurl'  ,$url ),
        pingking  => get_sbm( 'pingking', $url ),
      };
      $counts->{total} += $counts->{$_} foreach keys %$counts;
                                       # ブックマーク数合計
      $data = { 
        counts => $counts,
        ctime  => time(),
        expiry => $expiry,
      };
      $cache->freeze( $url, $data, $expiry );
        # キャッシュ書き込み
      return $data;
    }
  }
 
}
__END__