Amazon::SimpleDBで、URLに対し評価を保存するサンプルサイト
スポンサードリンク
(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です。
- Amazon Web Services Developer Community : Perl Library for Amazon SimpleDB
http://developer.amazonwebservices.com/connect/entry.jspa?externalID=1136 - Net::Amazon::SimpleDB::Simple
http://rjurneyopen.s3.amazonaws.com/SimpleDB/Simple.pm
です。
最初は、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&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__
スポンサードリンク
トラックバック(0)
トラックバックURL: http://blog.dtpwiki.jp/MTOS/mt-tb.cgi/2851
コメントする