2007/08/21

[技術系]   Amazonインスタントストアの登録商品データをダンプするスクリプト

at 17:17JST
指摘されるまで「できないできない…」と思っていたのだが、Amazonインスタントストアは、いつのまにか
「並べる商品ひとつひとつにコメントを書き込める」
ようになっていたらしい。

これだとAmazonのお好み商品をチョイス・分類して、自分で宣伝文句を考えて記録した簡易データベースになる。で、それをほかのネットサービスから呼び出して使う、と。

とりあえずインスタントストアをスクレイピングしてダンプする(汚い)スクリプト。そんで出力をJSONPにしておけば、静的コンテンツで参照できる、と。

あと、インスタントストアって、カテゴリーを複数階層もてるのね。見た目とか使い勝手とかはどうかと思うところもあるけれど、これだと類似サービスつくっても無意味だな。

#!/usr/bin/perl 

package bar::amazon::instant;

use strict;
use Jcode;
use LWP::UserAgent;

my $BASEURL = 'http://astore.amazon.co.jp';

sub GetCatsAndProds {
my $ID = shift @_;

my @cats = GetListOfCategories( $ID );
return # エラー
if ( $#cats < 0 );
my @result;
foreach my $cat ( @cats ) {
my $node = $cat->{node};
my $refProds = GetRefProdsOfCategory( $ID, $node )
or return # エラー
;
$cat->{prods} = $refProds;
if ( $#$refProds > -1 ) {
push( @result, $cat );
}
}
return # エラー
if ( $#result < 0 );
return @result;
}

sub GetListOfCategories {
my $ID = shift @_;

# トップページを取得する
my $cntToppage = GetEucURL( "$BASEURL/$ID" )
or return # エラー
;

# 全「カテゴリー」のnode ID、タイトルを取得する
my @cats;
my %cats;
while (
$cntToppage =~ m|href="/$ID/.*?node=([0-9]+)"[^>]{0,}>(.*?)</a>|g
# <a href="/$ID/503-6975305-3150324?%5Fencoding=UTF8&node=$node">$title</a>
) {
next if ( exists $cats{ $1 } );
$cats{ $1 } = $2;
push(
@cats,
{
node => $1,
title => $2,
}
);
}
# $cntToppage =~ m|href="/$ID/.*?node=([0-9]+)"|g
# http://astore.amazon.co.jp/$ID?node=$node
# として参照できる

#die if ( $#cats < 0 );
return @cats;
}

sub GetRefProdsOfCategory {
my $ID = shift @_;
my $node = shift @_;

my $urlBaseOfThisCategory = "$BASEURL/$ID?node=$node&page=";
my $pageNum = 1;
my $cntStackedPages;
while ( 1 ) {
my $cnt = GetEucURL( "$urlBaseOfThisCategory$pageNum" )
or return # エラー
;
$cntStackedPages .= $cnt;
$pageNum++;
last if ( $cnt !~ m|href="/$ID/.*?node=$node.{0,}?page=$pageNum">.*?&gt;.*?</a>| );
# 次ページ
# <a href="/$ID/503-6975305-3150324?node=$node&amp;page=$pageNum">次 &gt; &gt;</a>
}

my @prods;
my %prods;
#<td><a href="/hirosiki-22/detail/B000JG2DA0/503-6975305-3150324">アイドルマスター(通常版)</a>
#<br>
#<span class="price">¥ 6,069</span>
#<br>ああああアイドルスマター</td>
while (
$cntStackedPages =~
m|(<td><a href="/$ID/detail/[^"]+">[^<]+</a>.*?<span class="price">.*?</td>)|msg
) {
my ( $asin, $title, $price, $comment ) =
(
$1 =~ m|<a href="/$ID/detail/([^/]+)/[^"]+">([^<]+)</a>.*?<span class="price">([^<]{0,}?)</span>(.{0,}?)</td>|ms
)
;
$comment =~ s|<span [^>]+>.{0,}</span>||g;
$comment =~ s|<[^>]+>||g;
$comment =~ tr/\x0D\x0A//d;

next if ( exists $prods{ $asin } );
$prods{ $asin } = $title;
push(
@prods,
{
asin => $asin,
title => $title,
price => $price,
comment => $comment,
}
);
}

return \@prods;
}

sub GetEucURL {
my $url = shift @_;
return # エラー
if ( URLisnotSane( $url ) );

my $refConf = shift @_;
my $timeout = 6;
my $max_size = 128;
if ( $refConf ) {
if ( $$refConf{timeout} ) {
$timeout = $$refConf{timeout};
}
if ( $$refConf{max_size} ) {
$max_size = $$refConf{max_size};
}
}

my $ua = LWP::UserAgent->new(
agent => 'Mozilla/4.0 (compatible; MSIE 6.0)',
timeout => $timeout,
max_size => $max_size * 1024,
);
my $response;
$response = $ua->get( $url )
or return; # エラー
return # エラー
if ( !$response->is_success );
my $eucContent;
$eucContent = jcode( $response->content )->h2z->euc;
$eucContent =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
return( $eucContent );
}

sub URLisnotSane {
my $url = shift @_;
return 1
if (
( $url !~ m#^http://[^\./]+\.[^\./]# ) #要セカンドレベルドメイン
|| ( length( $url ) > 2048 )
);

my $host =
( $url =~ m#http://([^/]+)/?# )[0];
if ( $host =~ /^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}$/ ) {
my @c =
( $host =~ /^([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})$/ );
my $dec = $c[0]*(256**3)+$c[1]*(256**2)+$c[2]*(256)+$c[3];
return 1
if (
( ( 167772160 <= $dec ) && ( $dec <= 184549375 ) )
|| ( ( 2886729728 <= $dec ) && ( $dec <= 2887778303 ) )
|| ( ( 3232235520 <= $dec ) && ( $dec <= 3232301055 ) )
);
}
#Class A 10.0.0.0〜10.255.255.255 167772160〜184549375
#Class B 172.16.0.0〜172.31.255.255 2886729728〜2887778303
#Class C 192.168.0.0〜192.168.255.255 3232235520〜3232301055

return; # エラー
}

sub HTMLEscape {
my $i = shift @_;
$i =~ s/&/&amp;/g;
$i =~ s/</&lt;/g;
$i =~ s/>/&gt;/g;
$i =~ s/"/&quot;/g;
return $i;
}

sub UnHTMLEscape {
my $i = shift @_;
$i =~ s/\&lt;/</g;
$i =~ s/\&gt;/>/g;
$i =~ s/\&quot;/"/g;
$i =~ s/\&amp;/\&/g;
return $i;
}

1;

package main;
use strict;

use Data::Dumper;

$| = 1;

my $ID =
shift @ARGV
|| 'hirosiki-22'
;

my @result = bar::amazon::instant::GetCatsAndProds( $ID );
print Dumper( @result );


[技術系]   複数枚のプリント写真をいちどにスキャンする

at 11:46JST
現像しちゃった古い写真をパソコンに取り込みたい、ってニーズがあるわけですよ。でも、こういうのはだいたい枚数が多いのでスキャナで一枚一枚取り込むのはめんどう。

たとえば、
200708210100016.png
こんなふうに(勝手に某人の写真を使ってます。ごめん)、3,4枚の写真をまとめてスキャンして、パソコンが赤枠のように一枚一枚の写真を自動認識、
・分割
・微妙な傾きの補正
をして画像ファイルにしてくれたら便利。

こういうのは最近のスキャナでは附属ソフトの機能として搭載されていて、
エプソン→マルチフォトスキャン
キヤノン→ワンパスマルチスキャン
などと言っている。しかし、それぞれのメーカーの対応スキャナを買わなければ、もちろん使えない。

単独のソフトでこういう機能を実現してくれるものもあるはずだろ…と探したら、無料のソフトでは存在しないようだ。ふーむ。

代わりに、Adobe様のPhotoshop(CS2) / Photoshop Elementsにはこの機能があることがわかった。常識? だって、ぼくのPhotoshopはバージョン4だもんで知らなかったのよ。

Elementsで分割したいスキャン画像を読み込んだら、
2007082102mage2.png

メニューの
「イメージ」→「スキャンした画像を分割」
とすると、プリント領域を自動認識して
・切り抜き
・回転
をしてくれる。

結果は以下のように…。
2007082103mage4.png

なんか精度があまり高くなくて(悪く言えばバカ)、二枚づつに切られてしまった。
・写真同士がきちんと離れていないと認識に失敗する
・四角いくっきりした領域がある構図だと、写真の中を切り取られてしまう
といった感じか。

さらに、勝手に回転してくれてしまうし、適当なところで切って矩形にしてくれてしまうため、
・どことなく縦横比率が狂うような気がする
・上下左右が寸詰まりになる
といった問題も。あまり実用的じゃない。

ちなみにPhotoshopでは以下のようにメニューを呼び出すが、認識エンジンが同じもののようで結果はまったく同じになった。
2007082104mage1.png


とりあえず「矩形に切り出す」だけの手軽なツールがあればよいのだが、なぜか見あたらない。領域認識って、画像処理ではわりと歴史の長い分野だと思うのに底辺まで落ちてきてないのだなあ。

Intelの画像処理ライブラリ「OpenCV」を使ってうまくできないかと思ったが、Perl用のバインディングがないのであきらめた。Windows上でライブラリ使うのもめんどくさそうだし。Rubyのほうでは環境がきちんとそろってるのかな?
さらに過去の記事
2009/04 (1)   2008/12 (3)   2008/11 (9)   2008/10 (10)   2008/09 (20)   2008/08 (2)   2008/07 (23)   2008/06 (16)   2008/05 (22)   2008/04 (11)   2008/03 (21)   2008/02 (20)   2008/01 (21)   2007/12 (32)   2007/11 (37)   2007/10 (46)   2007/09 (63)   2007/08 (33)   2007/07 (41)   2007/06 (81)   2007/05 (173)   2007/04 (168)   2007/03 (113)   2007/02 (123)   2007/01 (92)   2006/12 (111)   2006/11 (185)   2006/10 (20)  

広告


この広告は60日以上更新がないブログに表示がされております。

以下のいずれかの方法で非表示にすることが可能です。

・記事の投稿、編集をおこなう
・マイブログの【設定】 > 【広告設定】 より、「60日間更新が無い場合」 の 「広告を表示しない」にチェックを入れて保存する。


×

この広告は1年以上新しい記事の投稿がないブログに表示されております。