July 2008 Archives

WWW::Mechanize::Plugin::Web::Scraperでスクレイピングをもっと簡単に

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

スクレイピングして何すんだと言われましても、スクレイピングがしたくてしょうがないmattnです。


今日、WWW::Mechanize::Plugin::Web::Scraperというcpanモジュールを(otsuneさんのブクマ経由で)見つけました。モジュール名の通り、WWW::MechanizeからWeb::Scraperするプラグインです。

先日書いた「何時でも何処でも携帯で「はてなスター」チェック」では、両方使ってagentを切り替えたりしてましたが、これを使うともっとスマートに書けるようになります。今日は小ネタでソースだけ。

use strict;
use warnings;
use WWW::Mechanize::Pluggable;
use YAML::Syck;

my $username = 'xxxxx';
my $password = 'xxxxx';

my $mech = WWW::Mechanize::Pluggable->new();
$mech->get('http://www.hatena.ne.jp/login?location=http://s.hatena.ne.jp/');
$mech->submit_form(
    form_number => 1,
    fields => {
        name     => $username,
        password => $password,
    }
);
$mech->get("http://s.hatena.ne.jp/$username/report");
my $stars = $mech->scrape('span.entry-title a', 'stars[]',
    { title => 'TEXT', link => '@href' }
);
warn Dump $stars;

いい感じにキレイですね。

CGI.pmのファイルアップローダ

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

今日は、Perlで作るファイルアップローダの基本ルーチンを書いてみようと思います。

最初に某業界のインターネットによるファイル送信の歴史を、僕の主観で書いてみます。関係ないようで、実は関係あるんです。

データ通信入稿の歴史

専用線やISDN Managerなど、インフラにコストをかけないと遠隔地への通信入稿ができない前インターネット時代が終わり、インターネット時代になると、首都圏にある全国ユーザを対象にした印刷サービス業や地方の通販印刷業がまず行ったのはFTPサーバまたはAnonymousFTPサーバを立てデータ通信入稿に利用することだったが、これらはユーザにFTPクライアントを設定してもらう説明のコストが非常に高いという欠点があり、次なる手段として、どこかの業者がWebブラウザによるファイル送信を設置したところ他の業者も同様の仕組みを設置して今に至る。

Webのフォームからのアップロードによって、データ通信入稿がものすごく容易になったのです。

本題行きますね。

Perlでファイル送信

さて、Perlでファイル送信するスクリプトですが、CGI.pmというモジュールは今時標準モジュールなので、これを使うと簡単にできます。

テンポラリファイルが書き込まれるディレクトリの設定

CGI.pmのテンポラリファイルが書き込まれる場所が変更できないと思われている人も多いですけれども、実は変更可能。

僕のコードはこんな感じ。

# -------------------------------------------------
# _set_tempdirectory ( $tempdir ) 
# -------------------------------------------------
# CGI.pm の内部設定の、TMPDIRECTORY を引数に変更する。
# CGI.pm 初期化する前に設定する必要がある
# ていうか、ここら辺アンドキュメンテッドなんじゃねー
# ていうきもしなくもない。後で調べる。 
 
sub _set_tempdirectory{
   
  my $tempdir = shift;
 
  if ($TempFile::TMPDIRECTORY) {
    $TempFile::TMPDIRECTORY = $tempdir; 
  } 
  elsif($CGITempFile::TMPDIRECTORY) {
    $CGITempFile::TMPDIRECTORY = $tempdir;
  }
 
  return;
}
このルーチンを、use CGI; した後、かつ、my $q = CGI->new; する前に実行します。

これ何に役立つかっていうと、アップロードCGI呼び出しの引数によってアップロード先のURLを区別したいときに使います。つまり、アップロード中のステータス、たとえばファイル転送済みの容量表示をしたいときに。

ここで、CGI.pm をよく使っている人は、「my $q = CGI->new; する前なのに、どうやってアップロードCGI呼び出しの引数をとれるの?」って思うかもしれません。そう、おなじみの$q->param('foo')でとれないんです。

しかし、引数とるのに、CGI.pmを使う必要はありません。$ENV{'QUERY_STRING'}をパースしちゃいましょう! Perl4時代に逆戻りですね!

テンポラリディレクトリにアップロードされたファイルの保存

この手のルーチン作例は、いっぱいWebにあがっているのですが、テンポラリディレクトリにあるファイルを、実際のファイルに保存するルーチンがみんなまちまちで、どれを使っていいか悩みます。

http://perldoc.jp/docs/modules/CGI.pm-2.89/CGI.podだと

   # バイナリ・ファイルをどこか安全なところへコピーします
    open (OUTFILE,">>/usr/local/web/users/feedback");
    while ($bytesread=read($filename,$buffer,1024)) {
       print OUTFILE $buffer;
    }

となっています。これスピード遅くね?

実際、最近の入稿データは余裕で1GBとかありますので、普通のやり方をしてたのでは、アップロード送信終了後の待ち時間がとても長くなりがちです。

とりあえず、僕は、File::Copyモジュールのmoveを使ってみました。これだったら、テンポラリディレクトリと、保存ディレクトリが同じファイルシステム上にあるのならば、一瞬で保存が終わってくれます。

ここで、CGI.pm をよく使っている人は、「moveって、たしか引数としてtarget pathとdestination pathの2つが必要で、ファイルハンドルだと駄目だったよね?」って思うかもしれません。そう、$q->upload('foo')をそのまま使えません。

でも、ちゃんと考えてあって、$q->tmpFileName( $q->upload('foo') )なんてすると、テンポラリファイルのパスが得られちゃうんです。これは便利。

実際には以下のようになります。

use CGI;
use File::Copy;
use File::Basename;

my $upload_dir  = 'upload';      # 保存先のディレクトリ
 
my $q  = CGI->new();             # CGIオブジェクト
my $fh = $q->upload('filename'); # ファイルハンドル兼ファイル名
my $temp_path = $q->tmpFileName($fh); # アップロードされた
                                      #ファイルのフルパス
fileparse_set_fstype('MSDOS');   # WinIE用パス文字設定
my $filename    = basename($fh); # アップロードされたファイルの
                                 # ファイル名
my $upload_path
  = "$upload_dir/$filename";     # 保存先フルパス
 
move ($temp_path, $upload_path)  # File::Copy の moveメソッドで
  or die $!;                     # 移動
close($fh);                      # おまじない
続きを読む以降では、僕が持っている実際のアップロードルーチンのソースが書いてあります。

何時でも何処でも携帯で「はてなスター」チェック

| 3 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

追記

コメント欄でotsuneさんにご指摘頂きました。scraperのprocess部、LWPの初期化をループ内で行わないようにしました。


やっぱり書いた記事にはてなスターが付くと嬉しいものですよね。出先でちょっとした間にはてなスターが付いているのを見て、ニタニタしたい人もいるかと思います。

でもはてなスターにはモバイルページがありません。しかもスターレポートページを閲覧するにはログインが必要になります。さて今日はモバイル端末から閲覧出来るエゴツール「モバイルはてなスターページ」を作って見たいと思います。

まずスターレポートページを見る為に、WWW::Mechanizeを使ってログインします。ログインページは

http://www.hatena.ne.jp/login?location=http://s.hatena.ne.jp/

となります。セキュリティを考慮されたいならばhttpsにされるのが良いかと思います。以下WWW::Mechanizeでログインする処理になります。

my $username = 'xxxxxxxx';
my $password = 'xxxxxxxx';

my $mech = WWW::Mechanize->new(timeout => 10, agent=>'StarScraper');
$mech->get('http://www.hatena.ne.jp/login?location=http://s.hatena.ne.jp/');
$mech->add_header('Accept-Encoding', 'identity');
my $res = $mech->submit_form(
    form_number => 1,
    fields => {
        name     => $username,
        password => $password,
    }
);

ログイン後の処理はWeb::Scraperでのスクレイピングになります。レシピは以下の通り

my $star_list = scraper {
    process 'span.entry-title',
        'stars[]' => scraper {
            process 'a', title => 'TEXT', link => '@href';
        };
    result 'stars';
};

そして上記mechをWeb::Scraperのuaに設定し、スクレイピングを実行します。

$star_list->user_agent( $mech );

my $u = "http://s.hatena.ne.jp/$username/report";
my $stars = $star_list->scrape( URI->new($u) );

さて、これだけではスターが付けられたURLの一覧しか取得出来ません。そこで、はてなスターAPIを使ってスターのエントリを取得します。はてなスターAPIのエントリ取得URLは以下の通り。

http://s.hatena.ne.jp/entries.json?uri=[URL]

このAPIに上記でスクレイピングしたURLを渡します。

my $ua = LWP::UserAgent->new;
for my $star (@$stars) {
    my $uri = 'http://s.hatena.ne.jp/entries.json?uri=' . URI::Escape::uri_escape($star->{link});
    my $req = HTTP::Request->new(GET => $uri);
    my $res = $ua->request($req);
    $res->is_success or return 0;
    my $json = from_json( $res->content );
    my @sts = @{$json->{entries}->[0]->{stars}};
}

ここで気をつける必要があるのですが、stsの要素はHASHの場合とスカラの場合があり、HASHにはスター情報が、スカラには"☆35☆"といった省略する数値が入っています。これに気をつけて以下の様に処理します。

    for my $st (@sts) {
        if (ref $st eq 'HASH') {
            print '<img src="http://s.hatena.ne.jp/images/star.gif" title="' . $st->{name} . '" />'
        } else {
            printf '<font color="#f4b128">%d</font>', $st;
        }
    }

全体のコードは以下の様になります。

#!/usr/bin/perl

use warnings;
use strict;
use URI;
use Web::Scraper;
use HTML::Entities;
use WWW::Mechanize;
use JSON;

my $username = 'xxxxxxxx';
my $password = 'xxxxxxxx';

my $mech = WWW::Mechanize->new(timeout => 10, agent=>'StarScraper');
$mech->get('http://www.hatena.ne.jp/login?location=http://s.hatena.ne.jp/');
$mech->add_header('Accept-Encoding', 'identity');
my $res = $mech->submit_form(
    form_number => 1,
    fields => {
        name     => $username,
        password => $password,
    }
);

my $star_list = scraper {
    process 'span.entry-title',
        'stars[]' => scraper {
            process 'a', title => 'TEXT', link => '@href';
        };
    result 'stars';
};
$star_list->user_agent( $mech );

print "Content-Type: text/html; charset=utf-8\n\n";
my $u = "http://s.hatena.ne.jp/$username/report";
my $stars = $star_list->scrape( URI->new($u) );
my $ua = LWP::UserAgent->new;
for my $star (@$stars) {
    printf "<a href=\"%s\">%s</a><br />&#x202C;\n", $star->{link}, encode_entities($star->{title});
    my $uri = 'http://s.hatena.ne.jp/entries.json?uri=' . URI::Escape::uri_escape($star->{link});
    my $req = HTTP::Request->new(GET => $uri);
    my $res = $ua->request($req);
    $res->is_success or return 0;
    my $json = from_json( $res->content );
    my @sts = @{$json->{entries}->[0]->{stars}};
    for my $st (@sts) {
        if (ref $st eq 'HASH') {
            print '<img src="http://s.hatena.ne.jp/images/star.gif" title="' . $st->{name} . '" />'
        } else {
            printf '<font color="#f4b128">%d</font>', $st;
        }
    }
    print "<br />\n";
}

携帯片手にニタニタしてみてはどうでしょうか。

strict プラグマについて

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

友達が以前、日記で「use strict; って何でデフォルトでオンになってないの?」と言うことを書いていたのを見て、そういえばどうしてなんだろうと思ったのを思い出したので、書いてみる。(use すると strict プラグマが効くようになるモジュールとかはありますね。moose とか。そういう需要はあると言うことですよね)

perl を始めた方は、知り合いに勧められて始めた場合、「とにかく use strict; を宣言しておくといいよ」と言われて付けていたり、フリーで配布されてる掲示板スクリプトを改造していて、「use strict; した方が良いっぽい」と思ってやってみたらエラーの嵐でさんざんな目にあったりしてい(る|た)人も多いかと思います。後者は昔の僕ですが。

まぁ、use strict をするとなぜいいのかは tomyhero さんがすでに書いているので、そちらを参照してください。

「use strict; って何でデフォルトでオンになってないの?」

言われてみれば確かに。何でなんでしょうか?
よく Perl を使っていて、Perl の黒魔術的なところも知っている人なら、strict を無効化しないと出来ない処理があることは理解されてますよね。でも、そういうときは "no strict;" として局所的に strict プラグマを無効化出来ることも知っているはず。

デフォルトがオンで必要なところで no strict するのであれば、理にかなってるような気もしますよね。

ただ、ここまではスクリプトやモジュールを書くときの話で、ワンライナーのユーザがデフォルトで use strict オンだと面倒なのかなーとか想像してます。
いちいち my 書くの面倒だよねとか、そんな感じなのかなーとか考えてみたんだけど、どうなんでしょうか?あくまで僕の考えです。

誰か答えを知っていたら教えてください!

追記

tomyhero さんの記事に理由が書いてあったのを突っ込まれました >_<("もう一つの使い方"ってところ)

感謝というのはいいですよね。なんか色んな人の意見聞いてみたい!

実用! 画像でブックマーク数を返すSBMからブックマーク数を数値で取得

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんにちは! この前会社のCentOS4のサーバをyumったらPerl5.8.5のパッケージが更新されてしまい、CPANから入れたEncodeモジュールがパッケージのでデグレードしてしまい、メール送信で使っていたencode('MIME-Header-ISO_2022_JP', $foo )が動かなくなって涙目になりました。

さて、前回実用! Perlで少しでもSBMのブックマーク数を多く見せる - perl-mongers.orgでは、いろいろなソーシャルブックマークサービス(以下SBM)に用意されたWeb APIにアクセスし、ブックマーク数の合計をとるということをやりました。

今回は、SBMから得られる特定URLのブックマーク数が、イメージで得られるタイプの場合、どうやって数値として使えるか、というのをやってみます。本来想定された用途以外の使い方にチャレンジする、という意味では、Hackと言えると思います。

~~~

たとえば、FC2ブックマーク、画像としてブックマーク数を表示できるようになっています。

http://bookmark.fc2.com/image/users/http://perl-mongers.org/

で、

が得られます。

コンピュータが画像から文字を解読するのは大変

SBMから得られる画像に数字が書いてある場合、その画像から数字を認識させるのはかなり困難です。あらかじめ得られる画像データの特徴リストを持っておき、それと照合する、なんてことをすれば簡単になりますが、SBMサービス側の気まぐれで、「画像内の数字をかっこよくしよう」、なんてやられてしまった日には涙目です。

というわけで、画像を解析して数字を得るって言うのはあんまり現実的ではないです。

隠れたところにブックマーク数として採用できるデータが!

さて、画像を解析するのがボツになったので、じゃあどうやって、ブックマーク数の情報を取得するのか、という話なんですけれども、先ほどの

http://bookmark.fc2.com/image/users/http://perl-mongers.org/

にブラウザでアクセスすると、

ブラウザのアドレス欄が、"http://bookmark.fc2.com/icons/00002.png"とかになっていることに注目。つまり、画像表示のために、画像アイコンのURLにリダイレクトされているのです。

このURLの中に、なにやらブックマーク数として採用できそうな文字列が入っているので、これを利用します。

リダイレクト先のURLだけを取得

PerlでHTTPの通信をするときによく使われる、LWP::UserAgentを使います。リクエスト用URLをGETすると、ヘッダに、転送先のURLが入って帰ってくるので、それを正規表現で数字部分だけ取り出し、数値として取り扱います。

下の例では、画像として取得できるサービス一般で使えるようにしてみました。

各ソーシャルブックマークサービス(SBM)のブックマーク数画像表示APIを調べた ::: creazy photograph [creazy.net]

にて、各SBMにて、画像として取得するときのリクエスト用URLと、リダイレクト先のURLが書いてありますので、そのようにやってみます。なお、@niftyクリップと、POOKMARKはこっちで調査して付け加えました。

(2008-07-06 13:06訂正:スクリプトの名前をsmb_img_count.plからsbm_img_count.plに変更。livedoor用画像ファイル取得アドレスがYahoo!用のものになっていたのを訂正。また、動作がわかりやすいように、リダイレクト先のURLを表示するようにし、実行例も変更しました。http://b.hatena.ne.jp/kits/20080706#bookmark-9198443より指摘いただきました。)

Filename: sbm_img_count.pl

use strict;
use warnings;
use LWP::UserAgent;
 
our $sbms = { 
       hatena =>
       {
         proxy   => 'http://b.hatena.ne.jp/entry/image/',
         regexp  => '/(\d+)\.png',
       },
       livedoor =>
       {
         proxy   => 'http://image.clip.livedoor.com/counter/',
         regexp  => '/(\d+)$',
       },
       yahoo =>
       {
         proxy   => 'http://num.bookmarks.yahoo.co.jp/image/large/',
         regexp  => '/(\d+)$',
       },
       buzzurl =>
       {
         proxy   => 'http://api.buzzurl.jp/api/counter/v1/image?url=',
         regexp  => '/(\d+)\.gif',
       },
       fc2 =>
       {
         proxy   => 'http://bookmark.fc2.com/image/users/',
         regexp  => '/(\d+)\.png',
       },
       nifty =>
       {
         proxy   => 'http://api.clip.nifty.com/api/v1/image/counter/',
         regexp  => '/(\d+)\.png',
       },
       pookmark =>
       {
         proxy   => 'http://pookmark.jp/count/',
         regexp  => '/(\d+)$',
       },
};
 
my $url = 'http://perl-mongers.org/';
print 0
    + get_sbm( 'hatena'  , $url )
    + get_sbm( 'livedoor', $url )
    + get_sbm( 'yahoo'   , $url )
    + get_sbm( 'buzzurl' , $url )
    + get_sbm( 'fc2'     , $url )
    + get_sbm( 'nifty'   , $url )
    + get_sbm( 'pookmark', $url );
print "\n";
 
exit;
 
 
sub get_sbm {
  my $service = shift;
  my $url     = shift;
  return get_sbm_imageicon( $service, $url )
}
 
# ブックマーク件数イメージ提供サービスから件数取得
sub get_sbm_imageicon {
  my $servce = shift;
  my $url    = shift;
  our $sbms;
  my $ua = LWP::UserAgent->new();
  $ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)');
  my $method = 'GET';
  #my $method = 'HEAD';
  my $req = HTTP::Request->new( $method,
                                $sbms->{$servce}->{proxy}.$url );
  my $res = $ua->simple_request($req);
  my $location = $res->header('location');
  print "$location\n";
  my $count = 0;
  if ( $location =~ m|$sbms->{$servce}->{regexp}| ) {
    $count = 0 + $1;
  }
  return $count;
}
実行例:
$ sbm_img_count.pl
http://b.hatena.ne.jp/images/users/normal/00134.png
http://image.clip.livedoor.com/img/users/small/00019.png
http://thumbnail.yimg.jp/number/large/7
http://cdn.buzzurl.jp/static/image/num/1.gif
http://bookmark.fc2.com/icons/00002.png
http://clip.nifty.com/images/counter/00000.png
http://pookmark.jp/images/count/3
147
$
便利に使うには、コマンドラインからの入力が@ARGVに入るので、コマンドラインからURLを入れて問い合わせるように改造する、CGI.pmモジュールを使って、URLのクエリーから問い合わせるように改造する、等々できるんじゃないかなと思います。


[続きを読む]以降では、画像でしかブックマーク数の情報を提供していないSBMで、SBM運営会社の代わりに、XML-RPCインターフェースのAPIを用意するというあさっての方向に突っ走ってみます。

デフォルト値のperlらしい指定法

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

のダイジェスト。

Scalarによるデフォルト値

sub num{
    my $num = shift || -1; 
    # ....
}

0や''を入力値として用いたい場合は

sub num{
    my $num = shift;
    $num = -1 if not defined $num;
    # ....
}

Perl 5.10.0 以降なら

sub num{
    my $num = shift // -1;
    # ....
}

Hashによるデフォルト値

以下で一発!

sub conf{
    my %arg = (
        lang => 'perl',
        rank => 1,
        @_ # ここが決め手!           
    );
    # ...
}

オブジェクトをnewしたいなら、以下がお手軽。

package A::Module
sub new{
    my $pkg = shift;
    bless {
        lang => 'perl',
        rank => 1,
        @_
    }, ref $pkg || $pkg;
}

Dan the Perl Monger

About this Archive

This page is an archive of entries from July 2008 listed from newest to oldest.

June 2008 is the previous archive.

August 2008 is the next archive.

Find recent content on the main index or look in the archives to find all content.

Categories

Pages

Creative Commons License
This blog is licensed under a Creative Commons License.
Powered by Movable Type 4.21-en