理系学生日記

おまえはいつまで学生気分なのか

読みたい本を図書館で借りれるのかどうかを読み取るスクリプト作った

perl

こないだ浦安の図書館を褒めちぎったばっかし(2008-05-19)なんですけど，じつはこの図書館にはちょっぴりムカついているので，その話をします．

ムカつく

浦安の図書館の蔵書はなかなかスゴくて，ミーハーなぼくが読みたい本とかは，たいてい図書館が買ってくれています．ところが図書館も予算が限られていますから，同じ本を何冊も買うわけにはいきません．

ここで重要なのはぼくがミーハーということですね．

最近は、「ある事象に対して（それがメディアなどで取り上げられ）世間一般で話題になってから飛びつく」という意味で使われる事もある。　

ミーハー - Wikipedia

こうなると他のミーハー野郎どもまで，ぼくが読みたい本を読みたがってしまうわけです．本当にもう，ミーハー野郎というのはどうしようもない!!

結果，ぼくが借りたい本はクソみたいなミーハー野郎が先に借りてしまって，ぼくは図書館にムダ足を踏むことになってしまう．みなさんもこれはなんとかしなければと，おもいっきし頭を捻って考えていることでしょうけど，遅い!!今日ぼくはそれを改善するためにモジュールをでっちあげた!

でっちあげ結果

何をしてるかというと，図書館の検索システムに借りたい本の名前をぶちこんで，その結果を取ってきてるだけです．
ただ，関係のない本がやたらヒットするのをなんとかしたいと思ったり，多くの本にヒットしたときにも対応させたいなーって思うなどしてたら，プログラムはどんどん汚くなっていった!!

こんな感じでつかう．

#!/usr/bin/perl
use strict;
use warnings;
use Library::BookStatus;
binmode( STDOUT, ':utf8' );

# 借りたい本のタイトル一覧を書いたファイルを読みこませる
my $bs = Library::BookStatus->new( { file  => 'book.rc' } ); 
# 本のステータスを取得
my @entries = $bs->book_status( "on" );

for my $entry (@entries) {
    print "$entry->{title}\n";
    for my $idx ( 0 .. @{ $entry->{place} } - 1 ) {
	print "\t$entry->{place}[$idx]: $entry->{status}[$idx]\n";
    }
    print "\n";
}

出力はこんな感じ．本のある図書館と，そのステータスを出す．

Head firstデザインパターン
	中央図書館: 貸出中

イノベーションのジレンマ
	中央図書館: 在架
	富岡分館: 貸出中

ライト、ついてますか
	中央図書館: 貸出中

システムの科学
	中央図書館: 在架

パターン指向リファクタリング入門
	中央図書館: 貸出中

ビューティフルコード
	中央図書館: 貸出中

新・物理入門
	中央図書館: 在架

Modern C++ design
	中央図書館: 在架

Exceptional C++ style
	中央図書館: 在架

Googleを支える技術
	中央図書館: 貸出中

システムの科学
	中央図書館: 在架

上達の法則
	中央図書館: 貸出中
	堀江分館: 貸出中

はじめての課長の教科書
	中央図書館: 貸出中
	中央公民館図書室: 貸出中
	当代島公民館図書室: 貸出中
	日の出公民館図書室: 貸出中

その数学が戦略を決める
	中央図書館: 貸出中
	中央公民館図書室: 貸出中
	富岡分館: 貸出中
	美浜公民館図書室: 貸出中
	当代島公民館図書室: 貸出中
	日の出公民館図書室: 貸出中

実コード

ぼくの能力が低いのと，図書館のシステムが返す HTML が汚いのがあわさった感じ．あと Perl 中での UTF-8 の取り扱いがまだわかってないよなー．

package Library::BookStatus;

use strict;
use warnings;
use utf8;
use WWW::Mechanize;
use Data::Dumper;
use Web::Scraper;
use utf8;
use Encode;
use Readonly;
use Carp;

sub p { print Dumper shift }

# 浦安市私立図書館検索ページ
Readonly my $search_uri => 'http://opac.city.urayasu.chiba.jp/opw/OPW/OPWSRCH1.CSP';

sub new {
    my ($class, $href) = @_;

    my @books;
    if ( defined $href->{file} ) {
        open my $fh, '<', $href->{file} 
            or croak "cannot open '$href->{file}': $!";
        while( <$fh> ) {
            chomp;
            push @books, $_;
            print "book: $_\n" if $href->{debug};
        }
        close $fh or croak "cannot close '$href->{file}': $!";
    }
    
    bless {
        mech  => WWW::Mechanize->new,
        books => \@books,
        debug => defined $href->{debug}
    }, $class;
}

# 引数の query (本のタイトルおよび著者に対する問合せ) に対して 
# GET を発行し，レスポンス中の content から検索にヒットした書籍へのリンクを
# ぶっこぬく
# ヒット数が多いときの「次ページ」からもぶっこぬく
sub book_links {
    my ($self, $uri, $links) = @_;

    $self->{mech}->get( $uri );

    print "retrieving $uri\n" if $self->{debug};
    my $l = scraper {
        process 'td[valign="top"]>b>a', 'links[]' => '@href';
        result 'links';
    }->scrape( $self->{mech}->content );

    
    push @$links, @$l if $l;

    my $nxt = $self->next_link();
    $self->book_links( $nxt, $links ) if $nxt;

    wantarray? @$links : $links;
}

# query を作成する
sub book_query {
    my ($self, %args) = @_;
    
    if ( $args{title} || $args{author} ) {

        my %field;
        $field{'text(1)'} = $args{title};
        $field{'text(2)'} = $args{author};

        my $m = $self->{mech};
        
        $m->get( $search_uri );
        # 今気づいたけど，これ submit_form だと一回分 GET がムダくさい？
        $m->submit_form( with_fields => \%field );
        return $m->uri;
    }
    return;
}

# 「次」へのリンクがあるかどうか
sub next_link {
    my $self = shift;

    # テーブルの形(td タグの数)が検索によって変わっていってる感じもするので
    # それに対応したかった．scraper を使うのは overkill なきもした．
    my $info = scraper {
        process 'table>tr[align="center"]>td a', 'text[]' => 'TEXT';
        process 'table>tr[align="center"]>td a', 'next[]' => '@href';
        result qw(text next);
    }->scrape( $self->{mech}->content );

    my $idx = 0;
    while( my $text = shift @{ $info->{text} } ) {
        $text = decode( 'utf-8', $text );
        last if $text =~ /次/;
        $idx++;
    }

    my $next_link = $info->{next}->[$idx];
    return $next_link;
}

sub get_status {
    my ($self, $links) = @_;

     my @bookname = map { quotemeta( $_ ) } @{ $self->{books} };
    my @greped;
    for my $link ( @$links ) {
        my $s = scraper {
	    process 'tr[class="main"]>td>a', 'title' => 'TEXT';
            process 'table[border="1"]>tr>td:nth-child(1)', 'place[]' => 'TEXT';
            process 'table[border="1"]>tr>td:nth-child(4)', 'status[]' => 'TEXT';            
            result qw(title place status);
        };
        print "fetching $link ...\n" if $self->{debug};
        my $result = $s->scrape( URI->new( $link ) );
	my @places = @{ $result->{place}  };
	my @status = @{ $result->{status} };
        $result->{title} =~ tr/Ａ-Ｚａ-ｚ＋　＆／/A-Za-z+ &\//;

	my $title = encode( 'utf-8', $result->{title} );
	next unless scalar grep { $title =~ /$_/i } @bookname;

        push @greped, { title  => $result->{title},
                        place  => \@places,
                        status => \@status };
                       
    }
    return @greped;
}

sub book_status {
    my ($self, $display) = @_;

    my @entries;
    for my $booktitle ( @{ $self->{books} } ) {
        print "processing ", decode( 'utf-8', $booktitle ), "\n"
            if $display;
        my $q = $self->book_query( title => $booktitle );
        my $links = $self->book_links( $q );
        
        push @entries, $self->get_status( $links );

    }
    return @entries;
}

1