実用！ Perlで少しでもSBMのブックマーク数を多く見せる

【ここからは長いだけでおもしろくないソースコーナーです】

一回取得したブックマーク数をローカルにキャッシュしたり、ブラウザキャッシュと協調したり、mod_perl下でも動いたりなど、よく分からないけれども高機能版みたいです。

http://labo.dtpwiki.jp/sbm/sbm.cgi

に設置してあるよ。使うときは、<script src="http://labo.dtpwiki.jp/sbm/sbm.cgi?url=http://perl-mongers.org/"></script> みたいにして使う。

#!/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 HTTP::Date;
use utf8;
use XMLRPC::Lite;
binmode STDOUT => ':utf8';

sbm();
exit; # ｵﾜﾀ


sub sbm {
  # 初期設定
  our $cachedir = '/home/cl/www/labo.dtpwiki.jp/html/sbm/cache';
    # mod_perl下ではフルパス必須。
  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でクリップしているユーザ数',
       },
       delicious =>
       {
         proxy   => 'http://badges.del.icio.us/feeds/json/url/data?url=',
         entry   => 'http://del.icio.us/url/',
         message => 'このエントリーを'
                   .'del.icio.usでブックマークしているユーザ数',
       },
       total =>
       {
         entry   => 'http://labo.dtpwiki.jp/sbm/sbm.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",
    );
  }
  else { # ブラウザキャッシュきかなかった
    show_js( $q, $url, $counts, $expiry, $ctime );
  }
  return; # ｵﾜﾀ
  
  
  # 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;
  }
  
  
  # SBMサービスからブックマーク件数取得
  sub get_sbm {
    my $service = shift;
    my $url     = shift;
    if ( $service eq 'delicious' ) {
      return get_sbm_delicious( $url );
    }
    else {
      return get_sbm_xmlrpc( $service, $url );
    }
  }
  
  # XMLRPCによるブックマーク件数取得（livedoor,hatena）
  sub get_sbm_xmlrpc {
    our $sbms;
    my $service = shift;
    my $url     = shift;
    my $result  = eval {
      XMLRPC::Lite->proxy(
                    $sbms->{$service}->{proxy},
                    timeout  => 10,
      )->call( $sbms->{$service}->{method}, $url )
       ->result
    };
    return $result->{ $url } || 0;
  }
  
  # 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;
  }
  
  # ブックマーク 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サービスからブックマーク件数取得
        hatena    => get_sbm( 'hatena',   $url ),
        delicious => get_sbm( 'delicious',$url ),
        livedoor  => get_sbm( 'livedoor', $url ),
      };
      $counts->{total} += $counts->{$_} foreach keys %$counts;
                                       # ブックマーク数合計
      $data = { 
        counts => $counts,
        ctime  => time(),
        expiry => $expiry,
      };
      $cache->freeze( $url, $data, $expiry ); # キャッシュ書き込み
      return $data;
    }
  }
}
__END__