2007-10-25

Web::Scraper + XML::LibXML

perl

via http://b.hatena.ne.jp/mattn/20071016#bookmark-6186564
scraper シェル上で組み合わせたら便利なのではと思い試してみた。

$ cat foo.html 
<html>
<body>
<div><span>aaa</span>bbb</div>
<div><span>ccc</span>ddd</div>
</body>
</html>
$ scraper foo.html

とりあえず抽出したいテキストを使ったりしてノードを特定し、そのノードを表す XPath を表示する。

scraper> use XML::LibXML
scraper> warn $_->nodePath foreach (
    XML::LibXML->new->parse_string($tree->as_XML)->findnodes('//node()[.="bbb"]'))
/html/body/div[1]/text() at (eval 46) line 1.

あとはその XPath を使っていつもどおり。

scraper> process '/html/body/div[1]/text()', WARN
bbb at /usr/bin/scraper line 18.

scraper> process '/html/body/div/text()', WARN   
bbb at /usr/bin/scraper line 18.
ddd at /usr/bin/scraper line 18.

理想はこんなんかな。

scraper> process '//node()[.="bbb"]', XPATH
/html/body/div[1]/text() at (eval 46) line 1.

使ってるモジュールが違うので簡単にはできそうもないけど。

2007-10-12

ISBN ハイフン編集用テーブル生成

perl

via http://d.hatena.ne.jp/natu_n/20061108/1162984712
ISBN はハイフンの位置が地域によって異なる。 The International ISBN Agency にあるスクリプトから編集用のテーブルを生成してみた。

#!/user/bin/perl
use strict;
use warnings;

use LWP::UserAgent;
use YAML qw/Dump/;
use JSON qw/objToJson/;

my $resp = LWP::UserAgent->new->get(
  'http://www.isbn-international.org/converter/ranges.js');
$resp->is_success
  or die;

my $areas = {};
my $js = $resp->content;
$areas->{$1} = {
    name => $2,
    ranges => [map { [split /-/] } split /;/, $3]
  }
  while ($js =~ /gi\.area(\d+)\.text="(.+)";\ngi\.area\d+\.pubrange="([\d\-;]+)";/g);

print Dump $areas;
print objToJson $areas;

# YAML
---
0:
  name: English speaking area
  ranges:
    -
      - 00
      - 19
    -
      - 200
      - 699
    -
      - 7000
      - 8499
    -
      - 85000
      - 89999
    -
      - 900000
      - 949999
    -
      - 9500000
      - 9999999
1:
  name: English speaking area
  ranges:
...

# JSON
{"99953":{"name":"Paraguay","ranges":[[0,2],[30,79],[800,999]]},"99923":{"name":"El Salvador","ranges":
...

実際ハイフン編集するときは探索しやすい形式に変換するかも。

調べごとをすると id:natu_n さんのところにたどり着くことが多い昨今。休み中に過去記事あさらせて頂きます。

2007-10-10

Web::Scraper Watch

perl

0.21_01 まで。

0.21_01 Thu Oct 4 01:05:00 PDT 2007
　　- Added an experimental filter support
　　　(Thanks to hirose31, tokuhirom and Yappo for brainstorming)
0.21 Wed Oct 3 10:37:13 PDT 2007
　　- Bumped up HTML::TreeBuilder dependency to fix 12_html.t issues
　　　[rt.cpan.org #29733]
0.20 Wed Oct 3 00:28:13 PDT 2007
　　- Fixed a bug where URI is not absolutized with a hash reference value
　　- Added eg/jp-playstation-store.pl
http://search.cpan.org/src/MIYAGAWA/Web-Scraper-0.21_01/Changes

フィルターが導入された。DEVELOPER RELEASE なので激しく変わる予感。

とりあえず今までどおりのコード。フィルターをいろいろ試したいのでかなり無駄なことします。

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

use Web::Scraper;
use URI;
use YAML;

my $uri = URI->new('http://d.hatena.ne.jp/hetappi/searchdiary?word=未読');
print Dump scraper {
  process '//div[@class="hatena-asin-detail"]/a[@href=~/\d{9}[\dX]/]',
    'values[]' => '@href';
}->scrape($uri);

---
values:
  - !!perl/scalar:URI::http http://d.hatena.ne.jp/asin/4873113296
...
  - !!perl/scalar:URI::http http://d.hatena.ne.jp/asin/4061825550

関数で URL 文字列に変換してみる。

sub to_string {
  $_->as_string;
}
print Dump scraper {
  process '//div[@class="hatena-asin-detail"]/a[@href=~/\d{9}[\dX]/]',
    'values[]' => ['@href', \&to_string];
}->scrape($uri);

---
values:
  - http://d.hatena.ne.jp/asin/4873113296
...
  - http://d.hatena.ne.jp/asin/4061825550

無名関数をその場で渡して ISBN(≒ASIN)だけ取得する。

print Dump scraper {
  process '//div[@class="hatena-asin-detail"]/a[@href=~/\d{9}[\dX]/]',
    'values[]' => ['@href', \&to_string, sub { /(\d{9}[\dX])/, $1 }];
}->scrape($uri);

---
values:
  - 4873113296
...
  - 4061825550

Web::Scraper::Filter のサブクラスを定義して ISBN13 に変換する。

package Web::Scraper::Filter::ISBN13;
use base qw(Web::Scraper::Filter);
use Business::ISBN;

sub filter {
  my ($self, $value) = @_;
  Business::ISBN->new($value)->as_isbn13->as_string([]);
}

1;

...

print Dump scraper {
  process '//div[@class="hatena-asin-detail"]/a[@href=~/\d{9}[\dX]/]',
    'values[]' => ['@href', \&to_string, sub { /(\d{9}[\dX])/, $1 }, 'ISBN13'];
}->scrape($uri);

---
values:
  - 9784873113296
...
  - 9784061825550

独自の名前空間にサブクラスを定義して、ブックオフオンラインの URL を生成する。

package MyFilter::BookOff;
use base qw(Web::Scraper::Filter);

sub filter {
  my ($self, $value) = @_;
  'http://www.bookoffonline.co.jp/feed/search,st=u,q=' . $value;
}

1;

...

print Dump scraper {
  process '//div[@class="hatena-asin-detail"]/a[@href=~/\d{9}[\dX]/]',
    'values[]' =>
      ['@href', \&to_string, sub { /(\d{9}[\dX])/, $1 }, 'ISBN13', '+MyFilter::BookOff'];
}->scrape($uri);

---
values:
  - 'http://www.bookoffonline.co.jp/feed/search,st=u,q=9784873113296'
...
  - 'http://www.bookoffonline.co.jp/feed/search,st=u,q=9784061825550'

これだと簡単すぎて意味ないけど、汎用的にクラスなり関数なりでフィルターを定義しておけば便利ですね。

ただ、おそらく miyagawa さんの本命は Web::Scraper with filters, and thought about Text filtersの後半にあるアイディアなんだろうなー。Plagger などと共通のインタフェースで、オプションを指定できたりするテキストフィルター。めっちゃ期待しています。

2007-09-24

今日の位置ログ地図

perl twitter google

今日は車であちこち行かなきゃならなかったので、モバツイッターの試用をかねて所々でその時居る地名を送っていた。せっかくなので地図上に表示してみた。

方法は、

Twitter API でステータス履歴取得
モバツイッター経由のステータス(地名)抽出
Google Maps API でジオコーディング
Google Maps 地図画像取得 URL 生成

かな。

で、結果。予想以上にしょぼかった…。画像が汚いのは容量抑えるのに JPEG で生成しているため。

もうちょっと経路とかわかるかと思ったんだけどなー。敗因は、

点(地名)が少ない
範囲が広い
こんなことする予定じゃなかったので地名がてきとー → 緯度経度取得失敗
送ったつもりの地名が登録できてない、室内かな
Twitter でやることじゃない

あたりかな。

一応、ソース。中心の位置とかズーム値とかあとから調整してるよ！

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

use LWP::UserAgent;
use JSON 'jsonToObj';
use YAML 'Dump';
use Readonly;

Readonly my $APIKEY => 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
Readonly my $ID => 'hetappi';

my $ua = LWP::UserAgent->new;
my $resp = $ua->get(sprintf 'http://twitter.com/statuses/user_timeline/%s.json', $ID);
my @places; 
foreach (reverse @{jsonToObj($resp->content)}) {
  push @places, $1
    if ($_->{text} =~ /^(.+)\[mb\]$/);
}
print Dump \@places;

my @latlongs;
foreach (do { my %tbl; grep { !$tbl{$_}++ } @places }) {
  my $resp = $ua->get(sprintf 'http://maps.google.com/maps/geo?q=%s&output=json&key=%s', $_, $APIKEY);
  my $obj = jsonToObj($resp->content);
  push @latlongs, {
      lat => $obj->{Placemark}[0]->{Point}->{coordinates}[1],
      long => $obj->{Placemark}[0]->{Point}->{coordinates}[0] }
    if ($obj->{Status}->{code} == 200);
}
print Dump \@latlongs;

my $url =
  'http://maps.google.com/mapdata?' .
  'latitude_e6=35658230&longitude_e6=139697702&zm=20000&w=500&h=500&cc=JP&min_priority=1&image_format=3';
my $no = 51;
$url .=
    sprintf '&Point=b&Point.latitude_e6=%d&Point.longitude_e6=%d&Point.iconid=%d&Point=e',
       $_->{lat} * 1000000, $_->{long} * 1000000, $no++
  foreach (@latlongs);
print $url, "\n";

なぜか駒沢公園が２つあるし、一番遠かった羽田空港ないし、明治公園が北海道だし。
見にくいので改行調整した。

[hetappi@lily work]$ perl ./mkmap.pl
---
- 中野坂上交差点
- 新宿大ガード西
- 四谷４丁目
- 明治公園
- 宮下公園
- 渋谷橋
- 駒沢公園
- 駒沢公園
- 玉川田園調布
- 大鳥居
- 品川シーサイド
- 中目黒
- 道玄坂
- 南青山
- 東京駅
- 国会前
- 新宿区役所
- 中野駅
---
- lat: 35.688699
  long: 139.716125
- lat: 43.334801
  long: 145.598708
- lat: 35.624597
  long: 139.660272
- lat: 35.600729
  long: 139.665848
- lat: 35.569082
  long: 138.554232
- lat: 35.608524
  long: 139.749549
- lat: 35.639115
  long: 139.701178
- lat: 35.65823
  long: 139.697702
- lat: 35.665656
  long: 139.717812
- lat: 35.681099
  long: 139.767084
- lat: 35.463821
  long: 135.400218
- lat: 35.69384
  long: 139.703549
- lat: 35.706032
  long: 139.665652
http://maps.google.com/mapdata?
latitude_e6=35658230&longitude_e6=139697702&zm=20000&w=500&h=500&cc=JP&min_priority=1&image_format=3&
Point=b&Point.latitude_e6=35688699&Point.longitude_e6=139716125&Point.iconid=51&Point=e&
Point=b&Point.latitude_e6=43334801&Point.longitude_e6=145598708&Point.iconid=52&Point=e&
Point=b&Point.latitude_e6=35624597&Point.longitude_e6=139660272&Point.iconid=53&Point=e&
Point=b&Point.latitude_e6=35600729&Point.longitude_e6=139665848&Point.iconid=54&Point=e&
Point=b&Point.latitude_e6=35569082&Point.longitude_e6=138554232&Point.iconid=55&Point=e&
Point=b&Point.latitude_e6=35608524&Point.longitude_e6=139749549&Point.iconid=56&Point=e&
Point=b&Point.latitude_e6=35639115&Point.longitude_e6=139701178&Point.iconid=57&Point=e&
Point=b&Point.latitude_e6=35658230&Point.longitude_e6=139697702&Point.iconid=58&Point=e&
Point=b&Point.latitude_e6=35665656&Point.longitude_e6=139717812&Point.iconid=59&Point=e&
Point=b&Point.latitude_e6=35681099&Point.longitude_e6=139767084&Point.iconid=60&Point=e&
Point=b&Point.latitude_e6=35463821&Point.longitude_e6=135400218&Point.iconid=61&Point=e&
Point=b&Point.latitude_e6=35693840&Point.longitude_e6=139703549&Point.iconid=62&Point=e&
Point=b&Point.latitude_e6=35706032&Point.longitude_e6=139665652&Point.iconid=63&Point=e
[hetappi@lily work]$

2007/10/07 追記
ちょっといじった。

2007-09-23

渋谷区立図書館調査

perl library

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

use Web::Scraper;
use LWP::UserAgent;
use HTTP::Response::Encoding;
use Encode;
use YAML;
use URI;

my $ua = LWP::UserAgent->new(keep_alive => 1);
$Web::Scraper::UserAgent = $ua;

my $resp = $ua->post(
  'http://www.lib.city.shibuya.tokyo.jp/Asp/Book_Kensaku_w.asp?Page=1',
  content => 'isbn=4-10-353413-3&tos=1&tzn=1&zas=1');
my $data = scraper {
  process '//tr[td/center/text()="○"]/td/a', href => '@href'
}->scrape(decode('sjis', $resp->content));

$resp = $ua->get(
  'http://www.lib.city.shibuya.tokyo.jp/Asp/' . $data->{href});
$data = scraper {
  process '//table[tr/th/center/text()="No"]/tr/td[7]', 'umus[]' => 'text';
}->scrape(decode('sjis', $resp->content));

print Dump $data;

[hetappi@lily work]$ perl ./shibuya.pl
---
umus:
  - '　'
  - '　'
  - '　'
  - '　'
  - '　'
  - '　'
  - 貸出中
  - 貸出中
  - 貸出中
  - 貸出中
  - 貸出中
  - 貸出中
  - 貸出中
  - 貸出中
[hetappi@lily work]$

ISBN10 ハイフンあり可、なし、ISBN13 不可、GET 不可、リクエスト２回、Shift_JIS。

2007-09-23

新宿区立図書館調査

perl library

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

use Web::Scraper;
use YAML;
use URI;

print Dump scraper {
  process '//table[tr/th]/tr[2]', info => scraper {
    process '//td[2]/font/a', href => '@href';
    process '//td[6]', umu => 'text';
  };
}->scrape(URI->new(
  'http://www.library.shinjuku.tokyo.jp/opac/cgi-bin/sellist?' .
  'type=0&allc=&page=1&keyword=&sentaku=or&title=&sentaku=or&' .
  'author=&sentaku=or&publish=&sentaku=or&isbn=4-87311-325-3&' .
  'pubydate1=&pubydate3=&bunrui=&syubetu=all&kan=all&media=all&count=1'));

[hetappi@lily work]$ perl ./shinjuku.pl 
---
info:
  href: !!perl/scalar:URI::http http://www.library.shinjuku.tokyo.jp/opac/cgi-bin/detail?
    biblioid=0004140424&type=0&count=1&before=
  umu: 貸出中
[hetappi@lily work]$

ISBN10、13、ハイフン有り無し可、リクエスト１回、EUC、GET 可、not well-formed。

2007-09-23

世田谷区立図書館調査

perl library

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

use Web::Scraper;
use LWP::UserAgent;
use URI;
use YAML;

$Web::Scraper::UserAgent = LWP::UserAgent->new(keep_alive => 1);

my $data= scraper {
  process '//table/tbody/tr/td/a', href => '@href';
}->scrape(URI->new('http://libweb.city.setagaya.tokyo.jp/clis/search?ISBN=9784061317772'));

$data = scraper {
  process '//div[strong]', umu => sub {
    $_->as_text =~ /所蔵数：(\d+)冊 貸出数：(\d+)冊/;
    $1 - $2;
  };
}->scrape(URI->new($data->{href}->as_string));

print Dump($data);

[hetappi@lily work]$ perl ./setagaya.pl 
---
umu: 3
[hetappi@lily work]$

ISBN10、13、ハイフン有り無し可、Shift_JIS、リクエスト２回、GET 可。