amazon
今更あのエントリにトラックバックが飛んでくるとは…ちょっとびっくり。
ともかくこちらから飛んできたんでちょっと見てみたら手直しするところが判明したんでいじってみた。
一つは出品されている本の総数の判定がおかしかったこと。総数の判定を値段が出ている個数で行っていた。しかしデータを取得しても点数が多い場合、「その他の〜商品」ってところを押さなければ次の商品は出てこないからそういう商品に関しては点数がずれてしまうのです。それを「〜商品」と書いてあるすぐ右にある数値を取得してそれを点数とみなすことにした。
もう一つは「アマゾン品切れ」の表示。これはさっきの所で公開されていたソースを見てそれで判断するのかってわかったんで追加した機能。question:1105319343で示されていたサイトの物が同じ方法で判定しているかどうかは分からないけれども、たぶんまあ同じ事だろうと。
で、対抗して（？）こっちもソース公開。
#!/usr/bin/perl use CGI qw/-nosticky :no_xhtml/; use LWP::Simple; use strict; my $q = new CGI; my $charset = 'Shift_JIS'; # 文字セット my $title = 'AmaZ1'; # <title>に書く物。まあ適当。 my $MAX_LINE = 3; # 表示する行数 my $stock = 0; print $q->header(-charset => $charset); my $code = $q->param('c'); #print $q->start_html(-lang => 'ja', # -head => CGI::meta({-http_equiv => 'Content-Type', # -content => "text/html; charset=$charset",}), # -title => $title); print qq{<html><head><title>$title</title>}, qq{<meta http-equiv="Content-Type" content="text/html; charset=$charset">}, q{</head><body>}; if($code) { $code =~ s/[^0-9A-Za-z#]//g; $code =~ tr/#/X/; # 携帯では # のが入力しやすいから my $url = "http://www.amazon.co.jp/exec/obidos/tg/detail/offer-listing/-/$code/all/"; my $data = get($url); if($data) { $data =~ s#\n##g; $stock = 1 if $data =~ m#<b>発送[^<]+</b>[^<]*発送します。<BR>#; $data =~ s#<b class=price>#\n#g; $data =~ s#<b class="sans">(.*?)</b>#\n$1\n#; $data =~ s#<td[^>]+> <b>[^<]+</b>\s*/\s*(\d+)#\nbooks:$1\n#g; $data =~ s#<b>ユ\x81\x5bズド商品</b>.*#\nused#; # \x5b = [ の為 $data =~ s#<b>新品</b>.*#\nnew#; $data =~ s#<b>コレク\x83\x5e\x81\x5b商品</b>.*#\ncollect#; # \x5e = ^ の為 $data =~ s#</b>.+?</td>##g; $data =~ s#</td>.*##g; $data =~ s#<.+?>#:#g; $data =~ s#￥#\\#g; my @prices = split /\n/,$data; shift @prices; my $title = shift @prices; shift @prices; # print "ISBN:$code", # $q->br, # $title, # $q->br; print "ISBN:$code<br>$title<br>"; my $line; my $count = 0; my $state = '?'; foreach $line (@prices) { next if $line eq 'new' or $line eq 'used' or $line eq 'collect'; $count += $1 if $line =~ /^books:(\d+)/; } print "[アマゾン品切]",$q->br unless $stock; print "[出品数:$count]",$q->br; $count = 0; my($price,$b_state); for(1..10) { last if $#prices < 0; $line = shift @prices; if($line =~ /^books:/) { shift @prices; next; } if($line eq 'used') { $state = 'U'; next; } if($line eq 'new') { $state = 'N'; next; } if($line eq 'collect') { $state = 'C'; next; } ($price,$b_state) = split /:/,$line; $b_state =~ s#ほぼ新品#ほ新#; # 「ほ新」はちょっとイヤだなあ… $b_state =~ s#非常に良い#非良#; $b_state =~ s#良い#良#; $b_state =~ s#新品#新#; print "$state:$price:$b_state",$q->br; $count++; last if $count >= $MAX_LINE; } } } &form; #print $q->end_html; print q{</body></html>}; exit; sub form { print qq{<form method="POST" action="$ENV{'SCRIPT_NAME'}">ISBN}, q{<input type="text" name="c" value="4" size="12" maxlength="10" accesskey="1" istyle="4">}, q{<input type="submit" value="見" accesskey="2"></form><br>}; =comment print $q->start_form(-method=>'POST'), 'ISBN', $q->textfield(-name=>'c', -default=>'4', -override=>1, -accesskey=>1, -istyle=>4, -size=>12, -maxlength=>10), $q->submit( -value=>'見', -accesskey=>2,), $q->endform, $q->br; =cut }
微妙に長い…。コメントアウトしてある部分を削除すればもう少し短くなるんだけどあえてそのままで。まあこう書いてもほぼ同じ物が出力されますよ、ということです。
なんか結局モジュール使って出力する方法の方がソースが長くなるような気もするし、出力されるHTMLもちと長くなる。携帯だとパケ代を気にしなけりゃならないだろうということで最終的に直書きの方法を採ることに。モジュールを使った方がわかりやすいのかも知れないけど。
で、9〜11行目が一応使う人によって書き換えて貰おうという部分。とは言っても実際にはタイトルしか書き換えないだろうけど。それに文字コードはこのままでは書き換えたところで文字化けするだけだしｗ
一つ補足。ISBNに含まれることのあるXはいちいち文字種を変更してから入力するのが面倒なため、#で代用することが可能。
で、これは自由に使って貰ってかまわないが、当然使用は自己責任で。
あ、データ構造が変わったら出力される文字があり得ないぐらい長くなる可能性があるから長さを制限した方がよかったかも…。
