Web::Scraper Watch

0.16 から 0.19。

0.19 Thu Sep 20 22:42:30 PDT 2007
    - Try to get HTML encoding from META tags as well, when there's
     no charset value in HTTP response header.

0.18 Thu Sep 20 19:49:11 PDT 2007
    - Fixed a bug where URI is not absolutized when scraper is nested
    - Use as_XML not as_HTML in 'RAW'

0.17 Wed Sep 19 19:12:25 PDT 2007
    - Reverted Term::Encoding support since it causes segfaults
     (double utf-8 encoding) in some environment

0.16 Tue Sep 18 04:48:47 PDT 2007
    - Support 'RAW' and 'TEXT' for TextNode object
    - Call Term::Encoding from scraper shell if installed

http://search.cpan.org/src/MIYAGAWA/Web-Scraper-0.19/Changes

内部的な改良がほとんどでしょうか。それらは省略して。

    - Support 'RAW' and 'TEXT' for TextNode object

XPath で テキストノードを指定しても動くようになった。

#!/usr/bin/perl
use strict;
use warnings;
use Web::Scraper;
use YAML;

print Dump scraper {
  process '//text()[.=~/\d{9}[\dX]/]', 'isbns[]' => 'text';
}->scrape(<<HTML
<div>477413192X</div>
<ul>
  <li>4873113377</li>
  <li>4063726266</li>
</ul>
HTML
);
[hetappi@lily work]# perl ./isbn.pl
---
isbns:
  - 477413192X
  - 4873113377
  - 4063726266
[hetappi@lily work]# 

このケースだと、テキストノード指定でなくても

  process '//*[text()=~/\d{9}[\dX]/]', 'isbns[]' => 'text';

で前からできてたので、あんまりいい例じゃないな。

Term::Encoding はおしいなぁ…。

env_proxy キタ

via http://use.perl.org/~miyagawa/journal/34461
Web::Scraper 0.15 がリリースされました。

0.15
   - Call env_proxy in scraper CLI
   - Added $Web::Scraper::UserAgent and $scraper->user_agent accessor to deal
    with UserAgent object
   - Don't escape non-ASCII characters into &#xXXXX; in scraper shell 's' and WARN

http://search.cpan.org/src/MIYAGAWA/Web-Scraper-0.15/Changes

ここを見てもらえたのかわかんないけど、scraper シェルが proxy 対応されてます。感謝です。

Web::Scraper Watch

env_proxy に喜びすぎて、ほかの更新を見逃してたのは内緒。
さっきちょこっと書いたけど、

 - Call env_proxy in scraper CLI

D:\>set HTTP_PROXY=http://userid:passwd@proxy.example.com:8080
D:\>scraper "http://quote.yahoo.co.jp/q?s=9684.t&d=t"
scraper>

とかして、プロキシを設定できるようになった。会社、大学な人で喜んでる人は多いんじゃないでしょうか。

 - Added $Web::Scraper::UserAgent and $scraper->user_agent accessor to deal
  with UserAgent object

LWP::UserAgent を設定/参照できるようになった。
今まで

my $scraper = scraper {
...
};
$scraper->__ua->proxy(http => 'http://userid:passwd@proxy.example.com:8080');
my $data = $scraper->scrape(...);

とかして参照は一応できてたけど、

$Web::Scraper::UserAgent = LWP::UserAgent->new(keep_alive => 1);
my $foo = scraper {
...
}->scrape(...);
my $scraper = scraper {
...
};
my $foo = $scraper->scrape(...);

$scraper->user_agent->cookie_jar({});
my $bar = $scraper->scrape(...);

とかできるようになった。LWP::UserAgent のサブクラス作ってごにょごにょとかもできる。なるほど。

 - Don't escape non-ASCII characters into &#xXXXX; in scraper shell 's' and WARN

scraper CLI で遊ぶ その2 - へたっぴ日記の例だと、

scraper> s
<html>
  <head>
    <title> Yahoo!&#x30D5;&#x30A1;&#x30A4;&#x30CA;&#x30F3;&#x30B9; - 9684.t </title>
...
  </body>
</html>
scraper> 

が、

scraper> s
<html>
  <head>
    <title> Yahoo!繝輔ぃ繧、繝翫Φ繧ケ - 9684.t </title>
...
...
  </body>
</html>
scraper> binmode STDERR, ':encoding(sjis)'
scraper> s
<html>
  <head>
    <title> Yahoo!ファイナンス - 9684.t </title>||<
...
  </body>
</html>
scraper>

に。

scraper> process '//table[@border="1"]/tr[2]/td[1]', WARN;
<td colspan="2" nowrap>&#x53D6;&#x5F15;&#x5024;<br />9/3 <b>3,570</b></td>

が、

scraper> process '//table[@border="1"]/tr[2]/td[1]', WARN;
<td colspan="2" nowrap>蜿門シ募&#128;、<br />9/14 <b>3,780</b></td>
scraper> binmode STDERR, ':encoding(sjis)'
scraper> process '//table[@border="1"]/tr[2]/td[1]', WARN;
<td colspan="2" nowrap>取引値<br />9/14 <b>3,780</b></td>
scraper>

に。めっさわかりやすくなったー。
関係ないけど、スクエニ順調だな。売らなきゃよかった…。

2007/09/18 追記
ちょっとはずしてた気がするので修正した。

scraper シェルで proxy 越え

うちの会社、 proxy を通さないと外へ出れません。

D:\>scraper http://www.yahoo.co.jp
GET http://www.yahoo.co.jp failed: 500 Can't connect to www.yahoo.co.jp:80 (Bad hostname 'www.yahoo.co.jp') at ...

scraper シェルを使う時は次のようにしてます。かなり強引なのでまねしないでください。

D:\>dir | scraper
scraper> $scraper->__ua->proxy(http => 'http://userid:passwd@proxy.example.com:8080')
scraper> $scraper->scrape(URI->new('http://www.yahoo.co.jp'))
scraper> process '//a[@href =~ /^https?:/]', 'hrefs[]' => '@href'
...
scraper> q
scraper> q
D:\>

ローカルでパッチあてちゃえば楽チンです。

D:\Tools\Perl\bin>cat scraper
...
  my $scraper = scraper { run_loop($_[0], $term) };
  $scraper->__ua->env_proxy();                            # koko
  my $result  = $scraper->scrape($stuff);
...
D:\>set HTTP_PROXY=http://userid:passwd@proxy.example.com:8080
D:\>scraper http://www.yahoo.co.jp
scraper>

2007/09/17 追記
Web::Scraper 0.15 にて proxy 対応されました。

品川区立図書館調査

品川区立図書館の所蔵状態チェック。あとでまとめるので結果は特に編集してない。

#!/usr/bin/perl
use strict;
use warnings;
use utf8;

use YAML qw(Dump);
use Encode qw(decode);
use Web::Scraper;
use LWP::UserAgent;
use HTTP::Response::Encoding;

my $ua = LWP::UserAgent->new(keep_alive => 1);
my $resp = $ua->get('http://lib.city.shinagawa.tokyo.jp/cgi-bin/Swwwsmin.sh?0');
my $ret = scraper {
  process '//form', action => '@action';
}->scrape($resp->content);

$resp = $ua->post(
  'http://lib.city.shinagawa.tokyo.jp' . $ret->{action},
  content => 'lcbs=or&ron0=m&ron1=m&ron2=m&ron3=m&srsl0=1&srsl1=1&tgid=010A&tkey=4103534036');
$ret = scraper {
  process '//a[pre]', href => '@href';
  process '//a[pre]/pre', umu => sub {
    $_->as_text =~ /\[(○|×|★)\]\s+$/;
    $1;
  };
}->scrape(decode($resp->encoding, $resp->content));

binmode STDOUT, ':encoding(sjis)';
print Dump($ret);
$ ./shinagawa.pl
---
href: /cgi-bin/Swwwsvis.sh?0+5986+1+1+0+331906+0+1
umu: ○
$

EUC、ISBN10ハイフン有り無し可、ISBN13不可、○(利用可)、×(貸出中など)、★(雑誌)、リクエスト2回、GET不可。

Google ブックの収録状態を調べる

使い捨て。ちょっと下調べに使っただけです。XPath とかいまいちです。

#!/usr/bin/perl
use strict;
use warnings;
use utf8;

use Web::Scraper;
use URI;

my $scraper = scraper {
  process '//font[@size="-1"]/span/span[@style]', status => sub {
    my $node = $_->find('font');
    $node ? $node->{color} eq '#999999' ? $node->as_text =~ /プレビュー/ ? 'summary' : 'snippet' : 'all' : 'part';
  };
  result 'status';
};

foreach my $isbn (@ARGV) {
  my $result = $scraper->scrape(URI->new('http://books.google.co.jp/books?as_brr=0&q=isbn:' . $isbn));
  print "$isbn : " . (ref $result eq 'HASH' ? 'none' : $result) . "\n";
}
hetappi@violet ~/work
$ ./googlebookscheck.pl 8590379817 4873112036 4061848925 4840237743
8590379817 : all
4873112036 : part
4061848925 : snippet
4840237743 : none
hetappi@violet ~/work

scraper CLI で遊ぶ その2

pushing Web::Scraper 0.13 that has code generation and more examples in eg/

http://twitter.com/miyagawa/statuses/243570942

今度はコード生成だそうで。0.12 もチェックしていなかったので、あわせて新機能を確認。scraper CLI で遊ぶ - へたっぴ日記の続きっぽく。
今日はスクエニYahoo!ファイナンスを題材に。

hetappi@violet ~
$ scraper 'http://quote.yahoo.co.jp/q?s=9684.t&d=t'

s コマンドで HTML ソースを表示。

scraper> s
<html>
  <head>
    <title> Yahoo!&#x30D5;&#x30A1;&#x30A4;&#x30CA;&#x30F3;&#x30B9; - 9684.t </title>
...
  </body>
</html>
scraper> 

いままではあらかじめブラウザかなんかでソースを確認してから実行していたけど、シェル上で簡単に確認できるようになったので便利!大きなものは見にくいので相変わらすブラウザで。

$tree 変数で解析済みのツリーが参照できる。

scraper> print $tree, "\n"
HTML::TreeBuilder::XPath=HASH(0x109f79fc)

自分で好きにいじっちゃって!ってことでしょうか。複雑で XPath で書けない(もしくは書き方がわからない…)時とかも使える。

scraper> system "wget $_->{src}" for grep { my $f = $_->{src}; $f =~ s!.+/!!; !(-f $f); } $tree->findnodes('//img')

前からだけどこんなのもある。普通使わないだろうけど細工?する時に使える。眠くなかったら最後に書く。眠いのでそのうち書く。

scraper> print $scraper, "\n"
Web::Scraper=HASH(0x108b5d84)
scraper> print $scraper->__ua, "\n"
LWP::UserAgent=HASH(0x109ddd08)

WARN は激しく便利。XPathCSS セレクタを修正しながらさっくり確認できる。

scraper> process '//table[@border="1"]/tr[2]/td[1]', WARN;
<td colspan="2" nowrap>&#x53D6;&#x5F15;&#x5024;<br />9/3 <b>3,570</b></td>
scraper> process '//table[@border="1"]/tr[2]/td[1]/b', WARN;
<b>3,570</b>
scraper>

で、 c コマンド。最後の入力(d や y などのコマンドは除く)から実行可能なコードを生成。

hetappi@violet ~
$ scraper 'http://quote.yahoo.co.jp/q?s=9684.t&d=t'
scraper> process '//table[@border="1"]/tr[2]/td[1]/b', price => 'text'
scraper> y
---
price: '3,570'
scraper> c
#!/usr/bin/perl
use strict;
use Web::Scraper;
use URI;

my $stuff   = URI->new("http://quote.yahoo.co.jp/q?s=9684.t&d=t");
my $scraper = scraper {
    process '//table[@border="1"]/tr[2]/td[1]/b', price => 'text';
};
my $result = $scraper->scrape($stuff);

XPath を修正していき正しく指定できたら 最後に c コマンドで実行用コードを生成する。あとは抽出結果を好きなよう編集すればよい。

c all で全ての入力からコードを生成することも。

scraper> process '//table[@border="1"]/tr[2]/td[2]/font', diff => 'text'
scraper> y
---
diff: -20 (-0.56%)
price: '3,570'
scraper> c all
#!/usr/bin/perl
use strict;
use Web::Scraper;
use URI;

my $stuff   = URI->new("http://quote.yahoo.co.jp/q?s=9684.t&d=t");
my $scraper = scraper {
    process '//table[@border="1"]/tr[2]/td[1]/b', price => 'text';
    process '//table[@border="1"]/tr[2]/td[2]/font', diff => 'text';
};
my $result = $scraper->scrape($stuff);
scraper>

もう便利すぎ。