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 );


関連しそうな過去記事:
さらに過去の記事
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)  
×

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