図書館の所蔵状況をスクレイピングするスクリプトをWWW::Mechanize::Pluggableを使って書いてみた

以前に図書館の所蔵状況を拾ってくるスプリプトをWeb::Scraperを使うように書き換えるという記事を書いたが、今回更に一歩進んでWWW::Mechanize::Pluggableを使うように書き換えてみた。
WWW::Mechanize::PluggableはWWW::MechanizeからWeb::Scraperを動かすモジュールでなぜ使うかというと、なにかの呪文のような長い長いクエリ文字列を固定で持ちたくないのとTOPページからゴリゴリと掘っていかないとクエリが組み立てられないサイトを楽にスクレイピングしたいのが目的。
今回は長いクエリを楽にする方を

• 以前は一段階目の検索を行うのに

〜略〜
#   冗談のような長い呪文
Readonly my $QUERY_URL_PREFIX =>
    'https://library.city.iwaki.fukushima.jp/wehome/we/opac/kensakucheck.jsp?'
    . 'kensaku.x=35&kensaku.y=22&sryskb0=1&allsryskb0=1&sryskb1=2&allsryskb1=2&sryskb2=3'
    . '&allsryskb2=3&sryskb_length=3&taisyokan1=0&kanmei_length=6&max_kensu=10&KSKNO1=019'
    . '&KEYWORD1=&ITTI1=1&f_kanzen1=0&ANDOR2=0&KSKNO2=020&KEYWORD2=&ITTI2=1&f_kanzen2=0'
    . '&ANDOR3=0&KSKNO3=005&KEYWORD3=&ITTI3=1&f_kanzen3=0&ANDOR4=0&KSKNO4=070&KEYWORD4='
    . '&ITTI4=1&f_kanzen4=0&tandoku=120&tandoku_keyword='
    ;
Readonly my $QUERY_URL_SUFFIX =>
    '&siborikomi=040&hanni1=&hanni2='
    ;
Readonly my $XPATH_1 =>
    '//p[3]/table/tr/td[3]/a';
〜略〜
scraper {
        process $XPATH_1, \&get_urls;
    }->scrape(URI->new($QUERY_URL_PREFIX . $isbn . $QUERY_URL_SUFFIX));

sub get_urls {
    my $node = shift;
    my $url  = URI->new_abs($node->attr('href'), $DETAIL_URL)->as_string;
    push(@{ $obj->{uri} }, $url);
    scraper {
            process $XPATH_2, \&get_detail;
        }->scrape(URI->new($url));
}

上で定義しているから多少見やすいけれど・・・

• 今回

〜略〜
Readonly my $QUERY_URI  =>
    "https://library.city.iwaki.fukushima.jp/wehome/we/opac/kensaku.jsp";
Readonly my $DETAIL_URI =>
    'https://library.city.iwaki.fukushima.jp/wehome/we/opac/';
〜略〜
my $mech = WWW::Mechanize::Pluggable->new();
$mech->get( $QUERY_URI );
#   必要な部分だけ穴埋めすればあとはmechがよしなに
$mech->submit_form(
    fields => {
        tandoku_keyword => $isbn,
    }
);

#   詳細ページをリンクがあれば所蔵している
my $uris = $mech->scrape(
            '//a[@href=~/itiranview/]',
            'uris[]',
#   絶対パスに変換
                sub{ URI->new_abs($_->attr('href'), $DETAIL_URI) }
);

コメントにも書いたけれど検索フォームの必要な部分だけセットして終わりというのはすごい楽

今回ちょっとはまったところ（ドキュメントをちゃんと読まないので）

Web::ScraperとWWW::Mechanize::Pluggableとではscrapeする時の構文が違う
Web::Scraperは

my $foo = scraper {
    process XPATH, 'bar[]', '@href';
}->scrape(URI->new(URI));

WWW::Mechanize::Pluggable

my $mech = WWW::Mechanize::Pluggable->new();
$mech->get(URI);
my $foo = $mech->scrape(
    XPATH, 'bar[]', '@href'
);

ソース全文

#!/usr/bin/perl
use FindBin::libs;
use strict;
use warnings;
use CGI;
use Encode;
use JSON;
use List::Util qw( first );
use Readonly;
use URI;
use WWW::Mechanize::Pluggable;

Readonly my $QUERY_URI  =>
    "https://library.city.iwaki.fukushima.jp/wehome/we/opac/kensaku.jsp";
Readonly my $DETAIL_URI =>
    'https://library.city.iwaki.fukushima.jp/wehome/we/opac/';
Readonly my $LIBNAME => {
    '総合' => '01',
    '小名' => '02',
    '勿来' => '03',
    '常磐' => '04',
    '内郷' => '05',
    '四倉' => '06',
};

my $obj = {
    key   => '07204',
    stock => JSON::false,
    lib   => {
        '01' => JSON::false,
        '02' => JSON::false,
        '03' => JSON::false,
        '04' => JSON::false,
        '05' => JSON::false,
        '06' => JSON::false,
    },
    name  => {
        '00' => 'いわき市立総合図書館',
        '01' => 'いわき市立総合図書館',
        '02' => 'いわき市立小名浜図書',
        '03' => 'いわき市立勿来図書館',
        '04' => 'いわき市立常磐図書館',
        '05' => 'いわき市立内郷図書館',
        '06' => 'いわき市立四倉図書館',
    },
};

my $q    = new CGI;
my $isbn = $q->param('isbn');
my $json = new JSON;
#   for debug
#$json->pretty;

my $mech = WWW::Mechanize::Pluggable->new();
$mech->get( $QUERY_URI );
#   必要な部分だけ穴埋めすればあとはmechがよしなに
$mech->submit_form(
    fields => {
        tandoku_keyword => $isbn,
    }
);

#   詳細ページをリンクがあれば所蔵している
my $uris = $mech->scrape(
            '//a[@href=~/itiranview/]',
            'uris[]',
#   絶対パスに変換
                sub{ URI->new_abs($_->attr('href'), $DETAIL_URI) }
);

for my $uri (@{ $uris->{uris} }) {
#   文字列に変換してpush
    push(@{ $obj->{uri} }, $uri->as_string);
    $mech->get( $uri );
    $mech->scrape(
        '//td[1]/b', 'dummy[]',
        ['TEXT',
            sub {
                ${ $obj->{lib} }{ $LIBNAME->{ $_ } || '01' } = JSON::true;
            }
        ]
    );
};
#   各館の所蔵状況をハッシュからリストに変換
my @vals = values %{ $obj->{lib} };
#   一カ所でも所蔵していたら$obj->{stock}をtrueに
#   多くても10数館なのでuniqはいらない？
if (first{ $_ eq 'true' } @vals) {
    $obj->{stock} = JSON::true;
};
print $q->header(-type => "application/x-javascript; charset=utf-8");
print $json->canonical->encode($obj);