M.C.P.C.

―むり・くり―プラスコミュニケーション(更新終了)


| トップページ |

2009年5月15日 23:05

Amazon::SimpleDBで、URLに対し評価を保存するサンプルサイト

このエントリーをはてなブックマークに追加 mixiチェック

(2016-03-02 追記)
文中で紹介しているNet::Amazon::SimpleDB::Simpleはもうなくなっているため使えません。よって、文中サンプルはそのままでは動きませんが、
http://cl.hatenablog.com/entry/amazon-simpledb-lib
というエントリにて、Amazonが配布しているAmazon::SimpleDB::Clientを使って書き換える方法を用意しております。それに従い修正したソースは文末に用意しました。リンク先のサンプルサイトでは書き換え済みです。

〜〜〜

うちとしてはWeb制作業務をやっておらず、そのくせAJAXとやらを覚えてしまったもんだから、RIPのWebクライアントはRIPの進捗状況をAJAXで更新すりゃいいのに、とか、無駄な突込みばっかりうまくなるわけですけれども、仕事にはあんまり役に立たないので、仕事じゃない時間に、Amazon SimpleDBのサンプルを作ってみました。

feed内のリンクを評価&図示 [labo.dtpwiki.jp]

あんまりAmazon SimpeDBをPerlで使っているサンプルがなかったので、ここでソースを書いておきます。

使用するPerlライブラリは、きのう書いたとおり、Amazon謹製のAmazon::SimpleDBと、Net::Amazon::SimpleDB::Simpleです。

です。

最初は、AJAXで呼び出されて、Amazon SimpleDBに書き込むpost.cgi。

filename: post.cgi

#!/usr/bin/perl
 
use strict;
use warnings;
use CGI;
use Config::Pit;
use JSON;
use Net::Amazon::SimpleDB::Simple;
#use CGI::Carp qw(fatalsToBrowser);
 
# Amazon Web Serviceのアカウント情報をConfig::Pitで管理
my $config = pit_get("sdb.amazonaws.com");
die "not preset account data in Pit." if !%$config;
my $AWS_ACCESS_KEY_ID     =  $config->{AWS_ACCESS_KEY_ID}
  or die 'AWS_ACCESS_KEY_ID not found.';
my $AWS_SECRET_ACCESS_KEY =  $config->{AWS_SECRET_ACCESS_KEY}
  or die 'AWS_SECRET_ACCESS_KEY not found.';
 
my $domain = 'positions';
 
# オブジェクト準備
my $q = CGI->new;
 
# クエリ解析
if ($q->param('url') ne '')  {
  # Amazon SimpleDBアクセス用オブジェクト準備
  my $sdb = Net::Amazon::SimpleDB::Simple->new( {
    AWS_ACCESS_KEY_ID     => $AWS_ACCESS_KEY_ID,
    AWS_SECRET_ACCESS_KEY => $AWS_SECRET_ACCESS_KEY,
    domain => $domain,
  } );
  # サニタイズ
  ( my $x = $q->param('x') ) =~ s/[^\d]//g;
  ( my $y = $q->param('y') ) =~ s/[^\d]//g;
  
  # Amazon SimpleDBに書き込み
  $sdb->put_attributes( $q->param('url'), {
    url => $q->param('url'),
    x   => $x,
    y   => $y,
  } );
}
 
# JSONで受け取ったパラメータを出力
my $param = $q->Vars();
print $q->header(
  -Pragma        => 'no-cache',
  -Cache_Control => 'no-store',
  -Expires       => 'now',
);
print objToJson( $param );
 
exit;
 
__END__

次は、onloadで呼び出されて、Amazon SimpleDBから読みだすget.cgi。

filename: get.cgi

#!/usr/bin/perl
 
# get.cgi faviconの配置位置をJSONで出力します。
 
use strict;
use warnings;
use CGI;
use Config::Pit;
use Digest::MD5;
use JSON;
use Net::Amazon::SimpleDB::Simple;
#use CGI::Carp qw(fatalsToBrowser);
#use Data::Dumper;
 
# Amazon Web Serviceのアカウント情報をConfig::Pitで管理
my $config = pit_get("sdb.amazonaws.com");
die "not preset account data in Pit." if !%$config;
my $AWS_ACCESS_KEY_ID     =  $config->{AWS_ACCESS_KEY_ID}
  or die 'AWS_ACCESS_KEY_ID not found.';
my $AWS_SECRET_ACCESS_KEY =  $config->{AWS_SECRET_ACCESS_KEY}
  or die 'AWS_SECRET_ACCESS_KEY not found.';
 
my $domain = 'positions';
my $positions = [];
 
# オブジェクト準備
my $ctx = Digest::MD5->new;
my $q   = CGI->new;
 
# Amazon SimpleDBアクセス用オブジェクト準備
my $sdb = Net::Amazon::SimpleDB::Simple->new( {
  AWS_ACCESS_KEY_ID     => $AWS_ACCESS_KEY_ID,
  AWS_SECRET_ACCESS_KEY => $AWS_SECRET_ACCESS_KEY,
  domain => $domain,
} );
 
# クエリ解析
my $urls = $q->param('urls');
$urls =~ s/'/''/g;
$urls =~ s/\\/\\/g;
$urls =~s/^\s+//;
$urls = qq("$urls");
$urls =~s/\s/" or url="/g;
# HTMLから要求されたURLに関してAmazon SimpleDBから取得
my $output = $sdb->select(
  'SELECT * from positions where url='.$urls
);
#die Dumper($output);
 
# 取得した位置データを整理
foreach my $res ( keys %$output ) {
  for (my $i = 0; $i < $#{$output->{$res}->{y}} + 1 ; $i++ ) {
    $ctx->add($output->{$res}->{url}->[0]);
    my $item;
    ( my $x = $output->{$res}->{x}->[$i] ) =~ s/[^\d]//g;
    ( my $y = $output->{$res}->{y}->[$i] ) =~ s/[^\d]//g;
    $item->{'id_'.$ctx->hexdigest} = {
      x => $x,
      y => $y,
    };
    push @$positions, $item;
  }
}
 
# JSONとして出力
print $q->header(
  -Pragma        => 'no-cache',
  -Cache_Control => 'no-store',
  -Expires       => 'now',
);
print encode_json( $positions );
 
exit;
 
__END__

出力するときのヘッダにno-cacheとか何やらついているのが、Win IE6がAJAXで読んだJSONをキャッシュとしてどんどんため込むのを防止するものです。see→ M.C.P.C.: IEのAJAXリクエストをキャッシュさせないでIEのキャッシュにも残さない方法

3つめは、HTML/JavaScriptのテンプレートを展開する、index.cgi。

filename: index.cgi

#!/usr/bin/perl
 
# index.cgi HTMLを出力します
 
use strict;
use warnings;
use CGI;
use Data::Visitor::Encode;
use Digest::MD5;
use HTML::Template;
use URI::Fetch;
use utf8;
use XML::Feed;
#use CGI::Carp qw(fatalsToBrowser);
#use Data::Dumper;
$CGI::DISABLE_UPLOADS = 1;
 
# オブジェクト準備
my $q   = CGI->new;
my $ctx = Digest::MD5->new;
 
# クエリ解析
my $feed_url = $q->param('url');
if ( $feed_url eq '' ) {
  $feed_url = 'http://feedproxy.google.com/hatena/b/hotentry';
}
 
# feed解析
my $entries = parse( $feed_url );
splice ( @$entries, 10 );
 
# HTML準備
my $tmpl = HTML::Template->new(
  filename          => 'index.tmpl',
  die_on_bad_params => 0,
  loop_context_vars => 1,
  default_escape    => 'HTML',
);
my $script_url = $q->url( -full => 1 );
$tmpl->param(
  loop_entries => $entries,
  feed_url     => $feed_url,
  script_url   => $script_url,
);
 
# HTML出力
print $q->header(
  -type    => 'text/html',
  -charset => 'UTF-8',
);
print $tmpl->output();
 
exit;
 
 
sub get { 
  my $uri = shift;
  my $ua = new LWP::UserAgent;
  $ua->agent( 'Mozilla/5.0 (Windows; U; Windows NT 5.1; '
             .'ja; rv:1.9.0.6) Gecko/2009011913 '
             .'Firefox/3.0.6'); # UAをFirefoxに偽装
  $ua->timeout( 20 );           # timeoutを20秒に設定
  my $res = URI::Fetch->fetch( "$uri",, UserAgent => $ua )
    or die URI::Fetch->errstr;
  return $res->content;
}
 
sub parse {
  my $feed_url = shift;
  my $entries = [];
  my $content = get( $feed_url );
  my $feed = XML::Feed->parse( \$content );
  exit unless $feed;
  foreach my $entry ( $feed->entries ) {
    $ctx->add( $entry->link );
    ( my $url_escaped = $entry->link ) =~ s/#/%23/g;
    push @$entries, {
      title       => $entry->title,
      url         => $entry->link,
      url_escaped => $url_escaped,
      id          => 'id_' . $ctx->hexdigest,
    };
  }
  my $dev = Data::Visitor::Encode->new();
  $entries = $dev->utf8_off( $entries );
  return $entries;
}
 
__END__

最後に、HTM/JavaScriptとなるindex.tmpl。

filename: index.tmpl

<?xml version="1.0" encoding="UTF-8"?> 
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.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>feed内のリンクを評価&図示</title>
    <meta name="author" content="CL" />
    <meta name="copyright" content="Copyright (c) 2009 CL" />
    <meta http-equiv="content-style-type"  content="text/css" />
    <meta http-equiv="content-script-type" content="text/javascript" />
    <meta name="description" content="feed内のリンクの評価を図示します。" />
    <meta name="keywords" content="RSS,feed,Amazon SimpleDB" />
    <link rev="made" href="mailto:aab61120@pop12.odn.ne.jp" />
    <link rel="shortcut icon" href="http://dtpwiki.jp/favicon.ico" />
    <link rel="index" href="http://blog.dtpwiki.jp/dtp/2009/05/amazonsimpledbu.html" />
    <link rel="next" href="http://blog.dtpwiki.jp/dtp/2009/05/amazonsimpledbu.html" />
    <link rel="stylesheet" type="text/css"
      href="//yui-s.yahooapis.com/2.7.0/build/reset-fonts-grids/reset-fonts-grids.css" />
    <style type="text/css">
      ul#sponsorList {
        background-color: #ddd;
        background-image: url(http://labo.dtpwiki.jp/dtpboostersponsers/dtpboostersponsers.jpg);
        width: 450px;
        height: 450px;
        position: relative;
      }
      ul#sponsorList li {
        display: inline;
        position: absolute;
      }
      ul#sponsorList li img {
        border: 0px;
        -webkit-box-shadow: #666 2px 2px 5px;
        -moz-box-shadow: 2px 2px 5px #666;
      }
      div.yui-b p {
        border-right : 1px solid #ccc;
        border-left  : 1px solid #ccc;
        border-bottom: 1px solid #ccc;
        padding: 	4px;
      }
      div.yui-b p img {
        border: none;
        vertical-align: middle;
      }
      div.yui-b p.first {
        border-top: 1px solid #ccc;
      }
      div.yui-b p a {
        text-decoration: none;
      }
      div.yui-b p a:hover {
        text-decoration: underline;
        color: red;
      }
      .odd {
        background-color: #eee;
      }
      #form-top {
        margin-bottom: 10px;
      }
    </style>
  </head>
  <body>
    
    <div id="doc" class="yui-t5">
      
      <div id="hd">
        <h1>feed内のリンクを評価&図示</h1>
        <h2>(デフォルトではてなのfeed)</h2>
        <form method="get" action="<tmpl_var name="script_url">"
          id="form-top" name="form-top">
          <label for="url">feed URL:</label>
          <input type="text" name="url" id="url"
            value="<tmpl_var name="feed_url">"
            style="width: 700px;"
            tabindex="1"
            accesskey="u"
          />
          <input type="submit" name="更新" value="更新"
            tabindex="2"
            accesskey="s"
            style="40px;"
          />
        </form>
      </div>
      
      <div id="bd">
        <div id="yui-main">
          <div class="yui-b">
            <ul id="sponsorList">
              <tmpl_loop name="loop_entries"><li class="module-list-item"
                id="<tmpl_var name="id">" title="<tmpl_var name="url">"
                ><a href="<tmpl_var name="url">" title="<tmpl_var name="title">"
                  target="_blank"
                  ><img src="http://favicon.dtpwiki.jp/<tmpl_var name="url">" 
                    alt="<tmpl_var name="title">" width="16" height="16" /></a
                ></li
              ></tmpl_loop>
            </ul>
          </div>
        <!-- yui-main -->
        </div>
        <div class="yui-b">
          <tmpl_loop name="loop_entries">
          <p id="p_<tmpl_var name="id">"<tmpl_if
            name="__odd__"> class="odd<tmpl_if
            name="__first__"> first</tmpl_if>"</tmpl_if>>
            <img src="http://favicon.dtpwiki.jp/<tmpl_var name="url">" 
              alt="<tmpl_var name="title">" width="16" height="16"
            />
            <a href="http://b.hatena.ne.jp/entry/<tmpl_var name="url">"
              target="_blank" rel="nofollow"><img
                src="http://b.hatena.ne.jp/entry/image/<tmpl_var
                  name="url_escaped">"
                alt="<tmpl_var name="title">のはてなブックマーク数"
                height="13"
          /></a>
          <a href="<tmpl_var name="url">" target="_blank"><tmpl_var
            name="title"></a>
          </p>
          </tmpl_loop>
        <!-- yui-b -->
        </div>
      <!-- body -->
      </div> 
      <div id="ft">
        
        <h2>つかいかた</h2>
        <p>ファビコンの上でマウスカーソルをホバー:サイト名が表示されます</p>
        <p>ファビコンをドラッグ:ファビコンの位置を移動します</p>
        <p>ファビコンをクリック:サイトを開きます</p><br />
        <hr />
        <p>
          <script type="text/javascript"
            src="http://labo.dtpwiki.jp/sbm/check.cgi?mode=js&amp;url=<tmpl_var
              name="script_url">"></script>
        </p>
      <!-- footer -->
      </div>
    <!-- doc -->
    </div>
    <script type="text/javascript" src="http://www.google.com/jsapi"></script>
    <script type="text/javascript">
      // Load jQuery
      google.load("jquery", "1.3.2");
      google.load("jqueryui", "1.7.1");
    </script>
    <script type="text/javascript">
      $(start);
      function start() {
        var items = $('.module-list-item');
        var urls = '';
        for (var i = 0; i != items.length; i++) {
          reposition( '#' + items[i].id, i*16, 0);
          urls += " "+ items[i].title;
        }
        var date = new Date();
        var timestamp = date.getTime();
        var position = $.get('get.cgi', {
            time: timestamp,
            urls : urls
          },
          callback, "json"
        )
      }
      
      function callback(f) {
        var params = f;
        var timer = setTimeout( function() { callback2(params); }, 100);
      }
      
      function callback2 (params) {
        var param = params.shift()
        if  ( typeof  param != 'undefined' ) {
          //alert(params.length);
          for ( var item in param ) {
            reposition( '#' + item, param[item].x, param[item].y );
          }
          var timer = setTimeout( function() { callback2(params); }, 35 );
          return;          
        }
        return;
      }
      
      function reposition ( selector, x, y ) {
        var top = Number( y );
        var left = Number( x );
        $(selector).css({top: top + "px",left: left + "px"});
      }
      
      var items = document.getElementsByTagName('li');
      for ( var i = 0; i != items.length; i++ ) {
        var item = items[i];
        var id = item.id;
        if ( id ) {
	      $( "#" + id ).draggable( {
	        containment: '#sponsorList',
	        stop: function( e, ui ) {
	          var id       = this.id;
	          var url      = this.title;
	          var position = $("#sponsorList").position();
	          var top
              = Math.floor( ui.absolutePosition.top  - position.top  );
            var left
              = Math.floor( ui.absolutePosition.left - position.left );
	          //alert( 'url: ' + url + ' top: ' + top + ' left: ' + left );
            $.post(
              'post.cgi',
              {  url: url, y: top , x:  left },
              function(text){
                //alert(text);
              }
            );
	        }
	      } );
	    }
	  }
    </script>
  
  </body>
</html>

肝心のAmazon::SimpleDBの準備や、ドメインの準備は割愛。ドメインは、amazon-simpledb-cli のコマンドラインツールで作っておくとよいです。

〜〜〜

(2016-03-02 16:18追記)

Amazon::SimpleDB::Clientを使うようにした修正後のプログラムを書いておきます。

filename: get.cgi

#!/usr/bin/perl
 
# get.cgi faviconの配置位置をJSONで出力します。
 
use strict;
use warnings;
use CGI;
use Config::Pit;
use Digest::MD5;
use JSON;
use Amazon::SimpleDB::Client;
#use CGI::Carp qw(fatalsToBrowser);
#use Data::Dumper;
 
# Amazon Web Serviceのアカウント情報をConfig::Pitで管理
my $config = pit_get("sdb.amazonaws.com");
die "not preset account data in Pit." if !%$config;
my $AWS_ACCESS_KEY_ID     =  $config->{AWS_ACCESS_KEY_ID}
  or die 'AWS_ACCESS_KEY_ID not found.';
my $AWS_SECRET_ACCESS_KEY =  $config->{AWS_SECRET_ACCESS_KEY}
  or die 'AWS_SECRET_ACCESS_KEY not found.';
 
my $domain = 'positions';
my $positions = []; 
 
# オブジェクト準備
my $ctx = Digest::MD5->new;
my $q   = CGI->new;
 
# Amazon SimpleDBアクセス用オブジェクト準備
my $sdb = Amazon::SimpleDB::Client->new(
  $AWS_ACCESS_KEY_ID,
  $AWS_SECRET_ACCESS_KEY,
);
 
# クエリ解析
my $urls = $q->param('urls');
$urls =~ s/'/''/g;
$urls =~ s/\\/\\/g;
$urls =~ s/^\s+//;
$urls = qq("$urls");
$urls =~ s/\s/" or url="/g;
# HTMLから要求されたURLに関してAmazon SimpleDBから取得
my $response = $sdb->select({
  SelectExpression => "SELECT * FROM positions WHERE url=$urls",
});
my $item_list = $response->getSelectResult->getItem;
#die Dumper($output);
 
# 取得した位置データを整理
for my $item ( @$item_list ) { 
  my $attribute_list = $item->getAttribute;
  my $output = {}; 
  for my $item2 ( @$attribute_list ) { 
    push @{$output->{$item2->getName}} , $item2->getValue;
  }
  for (my $i = 0; $i < $#{$output->{y} }; $i++ ) { 
    $ctx->add($output->{url}->[0]);
    my $item;
    ( my $x = $output->{x}->[$i] ) =~ s/[^\d]//g;
    ( my $y = $output->{y}->[$i] ) =~ s/[^\d]//g;
    $item->{'id_'.$ctx->hexdigest} = {
      x => $x,
      y => $y,
    };
    push @$positions, $item;
  }
}
 
# JSONとして出力
print $q->header(
  -Pragma       => 'no-cache',
  -Cache_Control=> 'no-store',
  -Expires      => 'now',
);
print encode_json( $positions );
 
exit;
 
__END__

filename: post.cgi

#!/usr/bin/perl
 
use strict;
use warnings;
use JSON;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Amazon::SimpleDB::Client;
use Config::Pit;
 
# Amazon Web Serviceのアカウント情報をConfig::Pitで管理
my $config = pit_get("sdb.amazonaws.com");
die "not preset account data in Pit." if !%$config;
my $AWS_ACCESS_KEY_ID     =  $config->{AWS_ACCESS_KEY_ID}
  or die 'AWS_ACCESS_KEY_ID not found.';
my $AWS_SECRET_ACCESS_KEY =  $config->{AWS_SECRET_ACCESS_KEY}
  or die 'AWS_SECRET_ACCESS_KEY not found.';
 
my $domain = 'positions';
 
# オブジェクト準備
my $q = CGI->new;
 
# クエリ解析
if ($q->param('url') ne '')  {
  # Amazon SimpleDBアクセス用オブジェクト準備
  my $sdb = Amazon::SimpleDB::Client->new(
    $AWS_ACCESS_KEY_ID,
    $AWS_SECRET_ACCESS_KEY,
  );
  # サニタイズ
  ( my $x = $q->param('x') ) =~ s/[^\d]//g;
  ( my $y = $q->param('y') ) =~ s/[^\d]//g;
 
  # Amazon SimpleDBに書き込み
  my $attributes = pairs_to_attributes({
      url => $q->param('url'),
      x   => $x,
      y   => $y,
  });
  my $res = $sdb->putAttributes({
    DomainName => $domain,
    ItemName   => $q->param('url'),
    Attribute  => $attributes,
  });
}
 
# JSONで受け取ったパラメータを出力
my $param = $q->Vars();
print $q->header(
  -Pragma       => 'no-cache',
  -Cache_Control=> 'no-store',
  -Expires      => 'now',
);
print objToJson( $param );
 
exit;
 
sub pairs_to_attributes {
  my $hash = shift;
  my @attributes;
  foreach my $key ( keys %$hash ) {
    push @attributes, {
      Name  => $key,
      Value => $hash->{$key},
    };
  }
  return \@attributes;
}
 
__END__

投稿 大野 義貴 [Perl] | |

トラックバック(0)

トラックバックURL: http://blog.dtpwiki.jp/MTOS/mt-tb.cgi/2851

コメントする