ブログが続かないわけ

この日記のはてなブックマーク数
Webエンジニアが思うこと by junichiro on Facebook

[Perl][微エロ注意]画像収集のときにいつも同じイディオムを書いているのをやめたい

このエントリーを含むはてなブックマーク hateb
画像収集スクリプトはみんなよく書くスクリプトのひとつだよね。
代表的な例としてこちらを見てもらおう。
ワンライナーで画像収集

とりあえずワンライナーの方はおいといて、下にあるスクリプト(引用)
#!/usr/bin/perl
use strict;
use LWP::Simple;
use File::Basename;

my $content = get(shift);
my @l = $content =~ m{<a.*?href="(http://[^"]+¥.jpg)"}gi;
map{mirror($_,basename($_))} @l;

十分シンプルでいいんだけどmirror メソッドの第2引数にファイル名を与えなければいけないのが面倒だと思ったことはない?毎回、File::Basename でファイル名を決めて、それを渡すってことをしてなーい?まあ、慣れればどうってことないんだけど、慣れれば余計コピペ感が襲ってくる。そこで、LWP::Simple にdownload というメソッドを追加して、下記のように書けるようにしてみた。
#!/usr/bin/perl
use strict;
use LWP::Simple::Download;

my $content = get(shift);
my @l = $content =~ m{<a.*?href="(http://[^"]+¥.jpg)"}gi;
map{download($_)} @l;
個人的にはすっきりしたけど、なんだか全然シンプルになった感じがしないのはなぜだろう。まあいいや。

LWP::Simple::Download は想像通り、内部でFile::Basename によるファイル名のセットをしているだけなので、とても簡単にかけると思っていた。例えばこんな感じで。
package LWP::Simple::Download;

use warnings;
use strict;
use Carp;
use File::Basename;
use base qw/ LWP::Simple /;

use version; our $VERSION = qv('0.0.3');

sub download {
my ($uri) = @_;
my $file = basename($uri);
mirror( $uri, $file);
return $file;
}

1;
ところが、これじゃ全然ダメ。download コマンドがないって怒られる。
Undefined subroutine &main::download called 
そりゃそうだ。これだけでは、download というメソッドがmain ルーチンに取り込まれない。その部分を追加しよう。LWP::Simple にならってExporter を使うのも考えたけど、Web::Scraper を参考に型グロブをいじることにした。use が呼ばれるとそのクラスのimport メソッドが実行されることを利用して。そこに、初期設定というか、型グロブにメソッドを紐づける処理を書く。こんな感じ。

追加したimport メソッドのみ抜粋
sub import {
my $pkg = caller;
no strict 'refs';
*{"$pkg¥::download"} = ¥&download;
}
これで実行する。それでもやっぱりだめ。こんどはLWP::Simple::Download にmirror なんてメソッドはないと怒られる。
Undefined subroutine &LWP::Simple::Download::mirror
LWP::Simple をuse base してるんだから、これは勘弁してよー。と、思うかもしれないけど、use base ではimport が実行されない。
perldoc base
The base class’ "import" method is not called.
つまり、LWP::Simple のimport が実行されないので、LWP::Simple::Download 側にmirror メソッドが取り込まれていないため、mirror を呼び出すところで、そんなメソッドがないということになってしまう。そのため、こんな書き方で正しいかわからないけど、明示的にLWP::Simple のimport を呼び出してやる。
sub import {
LWP::Simple->import; # 親クラスのimport を明示的に呼び出す
my $pkg = caller;
no strict 'refs';
*{"$pkg¥::download"} = ¥&download;
}
基本的にはこれで完成。ただ、このままだと、LWP::Simple::Download をuse しただけではget などのメソッドを使えないので、それらの主要メソッドも使えるようにimport を改良する。
sub import {
LWP::Simple->import;
my $pkg = caller;
no strict 'refs';
*{"$pkg¥::download"} = ¥&download;

# 主要メソッドを型グロブで設定する
my @func = qw/get head getprint getstore mirror/;
*{"$pkg¥::$_"} = ¥&$_ for(@func);
}
最終的なLWP::Simple::Download はこんな感じになる。
package LWP::Simple::Download;

use warnings;
use strict;
use Carp;
use File::Basename;
use base qw/ LWP::Simple /;

use version; our $VERSION = qv('0.0.3');

sub import {
LWP::Simple->import;
my $pkg = caller;
no strict 'refs';
*{"$pkg¥::download"} = ¥&download;

my @func = qw/get head getprint getstore mirror/;
*{"$pkg¥::$_"} = ¥&$_ for(@func);
}

sub download {
my ($uri) = @_;
my $file = basename($uri);
mirror( $uri, $file);
return $file;
}

1;

ちなみに冒頭で紹介したサイトにあるワンライナーは、これを使えばこう書き直せる。

既存(引用)
$perl -MLWP::Simple -MFile::Basename -e 'map{mirror($_,basename($_))} get($ARGV[0]) =~ m{<a.*?href="(http://[^"]+¥.jpg)"}gi;' http://metiss.blog92.fc2.com/blog-entry-142.html

LWP::Simple::Download を使って書き直す
$perl -MLWP::Simple::Download -e 'map{download($_)} get($ARGV[0]) =~ m{<a.*?href="(http://[^"]+¥.jpg)"}gi;' http://metiss.blog92.fc2.com/blog-entry-142.html

相変わらず、あまり変わらないw

[Perl][PHP]値がfalse ならtrue に、true ならfalse にするtoggle(ビット反転)はこう書ける

このエントリーを含むはてなブックマーク hateb
Perl またはPHP での話なので、「false は0 または、空文字列など」で、「true はそれ以外」としよう。

文字通りにif 文で分岐させるとこんな感じになる。

Perl, PHP 共通
if ( $bool ) {
$bool = '';
}
else {
$bool = '1';
}
こんな処理たまに見かけるよね。
ただ、いくらなんでも、これはちょっとうっとおしい。

そこで、3項演算子を使ってみるとこうなる。

Perl, PHP 共通
$bool = ( $bool ) ? '' : 1;

ところが、こないだObjective-C の本を読んでいたら、こんな書き方を見かけた。
bool = !bool;
おお、これはcool だ。

意味的にも、文法的にも、この書き方はPerl でもPHP でもいけそうだ。

Perl
use strict;
use warnings;
my $bool = '';
for (0..3) {
$bool = !$bool; # ここで反転
print $bool, "¥n";
}
結果
1

1

PHP
<?
$bool = '';
for ($i=0; $i<3; $i++) {
$bool = !$bool; # ここで反転
print $bool. "¥n";
}
結果
1

1

おお、ちゃんとできた。
意外と使う機会は少ないかもしれないけど、この書き方はなんかいい感じ。

遅ればせながらShibuya.pm #10 のまとめ

このエントリーを含むはてなブックマーク hateb
いっつも遅れちゃう。
そのくせ、たいしてまとまっちゃいない。

JPA(lestrrat dmaki)

〜2008年 草の根活動
Perl をとりまくFUD
  • Perl is dead
  • Perl ってCGIと同じでしょ
  • 遅いよね
  • Perl でシステムとか作れない
  • Perl の習得コストが高杉
  • Perl 覚えても仕事にならないでしょ

カリスマではなくPeople が必要

  • その人たちで作る現実的な団体

そこで法人

  • 契約を団体名義で結べる
  • 資産を団体名義で保有できる
  • 企業と「対等」に話せる

サポートされているというアピール

  • サポート期間が存在するというアピール

短期目標

  • Perl に対する「希望」「将来性」
  • Perl は仕事になる!
  • Perl 技術者はお買い得だよ!

課題

  • Perl の何をどうアピールするのか
  • 潜在的LLユーザーを人口をこちらにたぐり寄せたい

テーマ

  • 収益性はどこにあるのか
  • 効果はどこに対してあるのか

Perl OO入門(tokuhirom)

LL温泉の再現Perl CGI?
  • B::Deparse でインタプリタの解釈を見れる
  • ↓これらは同じこと
  • Point->new($args);
  • Point::new('Point', $args);

-----
わかりやすいOO入門だった。ただ、ちょっとジャンプ力が足りないんじゃないかと思った。

最近のライトウェイトウェブアプリケーションフレームワークのベンチ(hidek)

最初にCGI::Applicationありき。これは簡単。
もう少し大掛かりになるとCatalyst。
で、最近はまた、簡単なものに戻ろうよという動きで、Mojo。

App::Benchmark::WAF(by lestrrat)
Apache::Test を使ってベンチマークをtest のようにできるモジュール
ab -n 1000 -c 10

比較するのは下記
  • MENTA
  • NanoA
  • Yacafi

レンタルサーバで動くキラーアプリを作成する
お問い合わせフォームをCatalyst で作るのはナンセンス

Yacafi(Yappo)

CGIのアプリケーションフレームワーク
Yacafi.pm とcgi ファイルをアップするだけ

dispatcher
query parser
mini template
(M)VC

controller と view の扱いを楽にしている

ターゲット
すごく小さなCGI
小さくて軽いフレームワーク

Data::Model
Data::ObjectDriver を参考にしたORM

-----
Data::Model に非常に興味がある。
hidek さんも3つのフレームワークのうちでは、少ししっかりしたアプリを作りたいと思ったときには、Yacafi が一番良さそうと言っていた。

MENTA(tokuhirom)

MENTA::Template から fork
自動でHTML のエスケープとかしてくれる

HTTP::Session で簡単にセッション管理できる
Webアプリケーションフレームワークに必要な全てが含まれている
/extlib のなかに必要なものが全て入ってるぜ
tokuhirom セレクト!

Pure Perl
すべて関数で!
-----
/extlib の中身に興味がある。
MENTAを使わなくても、この中身を見ておくのは参考になるかも。

NanoA(kazuho)

ディスパッチテーブル -> ファイルパスでいいじゃん
テンプレート -> エスケープ自動
PHP スタイル

インストーラ
サンプルアプリケーションがある

-----
どうでもいいことだけど、ZIGOROu さんが「奥さん」と言っているときは、kazuho さんのことなのか、嫁さんのことなのか区別がつかない。

Mojo(charsbar)

MyApp->run();
テストを気軽に作れる

小さな環境なら付属のサーバでデプロイしてもいい

デモ

Mojolyst
Mojolicious
-----
こんなにフレームワークがあると悩ましい。「とりあえずCatalyst」という思考はやめて、少しいろいろ見てみたい。ロリポで動くというのもとても興味が持てる。

Remedie(miyagawa)

動画専用の「Plagger/RSSリーダー/あとで見る」みたいなもの
デモ
opml のインポート

フロントはjQuery とCSS で

del.icio.us に登録したやつを見るってのが、いまのところ使い勝手が良さそう。
ローカルのディレクトリも登録できるようになっている

ノンブロッキングになるようにしたい
せっかくHTTP::Engine を使っているので

-----
「10時間のフライト」という空き時間で、オフラインの機能を充実させるという考え方が素晴らしい。ローカルのディレクトリを登録して、そこにある動画をRemedie で見るというのは、そこで作られた。
どうでもいいけど、remedie でgoogle 検索すると、僕のどうしようもないエントリ(週末にRemedie を試してみた)が一番に来てしまい、この後Dos攻撃みたいなアクセスがあった。

Kamaitachi(typester)

github.com/typester/kamaitachi
perl で書かれた Flash Media Server

Remoting
Shared Object
Media Streaming
静的ファイルのオンデマンド配信

Shared Object いらなーい
Media Sreaming
静的ファイルのオンデマンド配信は不可

package Service::LiveStreaming;
use Moose;

extends 'Kamaitachi::';

今後の予定は録画サポート
各種静的メディアファイルのストリーミングを

Video::Libavformat

パッケージングをしたい
-----
とにかく超期待。
できれば、いろいろと使ってみてフィードバックしたい!

Web サービスでSSD を使う(kazuho)

HDDのアクセス速度が遅いよね
計算方法の提示

自作のベンチマークツール

全文検索は参照局所性が低い -> キャッシュしづらい

Write パフォーマンス 14倍
Read 4〜6倍

シーケンシャルライトが遅い
DBのリストアで顕著

DB on SSD について
アクセス単位が小さい場合におすすめ
キャッシュの削減が可能
スレーブをSSD化すれば壊れても影響少

Senna on SSD
100万クエリ/日 程度でいけるね
-----
相変わらず凄まじい。
とりあえず、もう少し人柱になって頂いてw
それから本番投入したい。

LT

Acotie

Moxy について
基本的に知っていることだったけど、うちの社員に説明するのに格好の題材となるプレゼンだった。
ありがたい。

ちなみに一番助かったのは、MacBook をプロジェクタにつなぐときの設定が垣間みれたこと。
miyagawa さんのサポート
60Hz 1024 * 768

lopnor

Hadoop
Log anolyzing の話

コマンドラインで...

App::Hachero

log analyzing framework
plaggable

EC2 でも使えるよ!

何回あっても僕のことを覚えてくれない。
なのに、傘に入れてくれたりして、意外とやさしい。

ふじごろう

use B;

SV 構造体にアクセス
オペコードにアクセス

livedoor リーダー

Q4M
job & que

Devel::NYTProf
すばらしい視覚かツール

libxml2 のDTD取得が遅過ぎ

バックグランドでキャッシュをリアルタイム生成
ページング等のユーザー行動を予測できるところでは便利

Yokohama.pm #3 でしゃべってきた

このエントリーを含むはてなブックマーク hateb
Perl を使ってモンテカルロ法によるゲームAIを実践してきた。
ルールの簡単○×ゲームを使って、アルゴリズムを説明した。

ま、Perl は関係ない。というか、むしろ合わない><

スライドをあげておいた。
Perl でモンテカルロ法

初めてプレゼンしてみて、いろいろと反省すべきところがあった。

  1. MacBookをプロジェクタに設定するのに手間どる
  2. スライドやデモの文字の大きさが適切か気になる
  3. しゃべりながら書くのは結構難しい
  4. ライブコーディングではタイポが異常に多くなる


プロジェクタの設定は、前日のShibuya.pm でAcotie さんが苦戦していたのを見ていたので、こういう可能性もあるということは想定できていた。で、そのときにどんな設定にすればいいのかも、そっとメモっておいたので大事にはいたらなかったけど、自分が思っていた画面サイズでプレゼンできなかった。

スライドの文字の大きさに着いては、Spork のデフォルトのままだったし、ingy もtypester さんもいつもそのまま使っているような気がしていたので、特に設定を変えなかったけれど、会場次第では見にくいこともあるんだと思った。おそらく、全体的に文字は小さかったのではないか。デモのときはMac の機能で少し画面を大きくしたけど、そうすると思いのほか使いづらく、困った。

マイクの位置の問題かもしれないけど、しゃべりながら書くのは難しかった。特別声が小さいわけでもないし、あのくらいの会場なら地声の方が楽だということがわかった。(後半はclouder さんのアドバイスもあり、地声でやった)

typo が多くて恥ずかしかった。typester さんの早さ、正確さを見習って勉強したい。
Yappo さんもあのくらいの速度では書けそうだと、懇親会で言っていた。
ライブコーディング大会とかあったらまったく叶わないんだろうな。
素敵だね。

プレゼンでお見せした○×ゲームができるクラス(Games::TicTacToe)と、それを使うstart_tictactoe.pl はcoderepos にあげてある。
http://coderepos.org/share/browser/lang/perl/Games-TicTacToe/trunk

懇親会でtomi-ru にも言われたけど、ゲームをやるクラスとモンテカルロのアルゴリズムは別のクラスにして、モンテカルロのアルゴリズムだけを都合よく使えるようにしたい。

週末にRemedie を試してみた

このエントリーを含むはてなブックマーク hateb
レポジトリの移行に伴い、一部修正した(2009/03/03)

Remedie を試す

Shibuya.pm やYokohama.pm の予習として、最新のmiyagawa プロダクトであるRemedie を試してみた。

Remedie 概要


( From Google Code) 手抜きでごめんなさい。
Remedie is a perl based media center application with pluggable architecture. You can subscribe to videocast feeds, watch local folder with media files and keep track of your favorite video sites like YouTube, Nico Nico Douga or Hulu.

It works as a web server so you can use your favorite browser (Firefox, Safari) to browse your video collection, playback videos using your favorite player (JW Flash Player, VLC or Quicktime). Its plugin architecture will also allow you to add new subscription to online video sites.

If you're familiar with Plagger, Remedie is a fork of Plagger, optimized for media downloading and viewing, and comes with a HTTP web server with JSON APIs and web-based frontend built with jQuery and CSS.

(旧)インストール


まず、自分のPCに適当なディレクトリを用意する。
mkdir -p ~/Work/remedie
cd ~/Work/remedie
レポジトリから最新のソースコードを持ってくる
git svn init http://remedie.googlecode.com/svn/trunk/
git svn fetch
今後は
git svn rebase
で最新のコードを追いかけることができる。
cd trunk
trunk の中に

[追記]2009/03/03 Google Code のレポジトリ削除に伴い

新インストール


上記のインストール方法は古いのでこちらを参考に
作業ディレクトリに移動してレポジトリから最新のソースコードを持ってくる
git clone git://github.com/miyagawa/remedie.git
そうするとremedie というディレクトリができ、そこにソースコード一式が落ちてくる。cd remedie とかしてその中に入る。今後は
git pull
で最新のコードを追いかけることができる。ここにHACKING というファイルがあるので、これを見ればとりあえずの使い方がわかる。まずはこれを試してみる。いきなり実行してもほとんどの場合、CPANモジュールが不足していて、いろいろとエラーが出ると思うので、とにかく必要なモジュールをそろえないといけない。

僕の環境で、追加でインストールしたモジュールは下記の通り
DBD::mysql
DateTime::Format::Builder
DateTime::Format::MySQL
FindBin::libs
HTTP::Server::Simple
JSON::XS
Module::Install
MooseX::ClassAttribute
MooseX::ConfigFromFile
MooseX::GetOpt
MooseX::Types::Path::Class
Rose::DB
Rose::DB::Object
String::CamelCase
XML::RSS::LibXML

他にもやってみた人がいるので、こちらも参考になる
Remedie を試してみる #1 - Holidayworking::Diary
DBD::SQLite
DateTime
Feed::Find
FindBin::libs
HTTP::Engine
JSON::XS
Log::Log4perl
MIME::Types
Module::Install
MooseX::ClassAttribute
MooseX::ConfigFromFile
MooseX::Getopt
Rose::DB
Rose::DB::Object
String::CamelCase

この辺は、各自の現在の環境にも依存するので、これらは参考にとどめて、適宜トライアンドエラーでやって頂きたい。

ちなみに、XML::RSS::LibXML はRSS 0.91 問題でテスト時にエラーになるので、出来る人はXMLカタログを修正する等で、対応してほしい。そうでない人は、force install してしまえば良いだろう。

(参考)
本を読む RSS 0.9のDTDがlibxmlでエラーになる
本を読む RSS 0.9のDTDをXMLカタログでさしかえる
本を読む DebianやUbuntuでXMLカタログを変更する

起動


HACKING に書いてある最初の部分は初期化に関するもの
rm -r ~/.remedie
perl -Ilib -MRemedie::DB::Schema -e 'Remedie::DB::Schema->install'
初めて試すとき、もしくはまた一からやり直したいときにこの部分を実行する。
モジュールが足りない場合はこの時点でエラーが吐かれるので、それを参考に足りないモジュールを補う。
perl -Ilib ./bin/remedie-server.pl
これで実行できる。
これを実行すると、Web サーバのデーモンが起動するので、http://localhost:10010/ でそれにアクセスする。
うまくいくと、こんな画面が表示される。

だが、実際にはうまくいっていなくても、この画面が表示されるときもある。
内部的にJSなどでいろいろなURIが呼び出されていて、そこでエラーが起きているケースもあるからだ。例えばSafari で試している場合であれば、ウィンドウ > 構成ファイル一覧 とたどってみれば、どこのURIで内部エラーが出ているかがわかるので、それを見てみると良い。で、そこで出ているエラーの詳細は、log に吐かれているので、そちらも参考にすれば、何がいけないかもわかるはずだ。

log は ~/.remedie というディレクトリの中にある。
デバッグするときにこれは重要。


それでは、早速チャンネルを登録してみよう。
チャンネルの登録は、右上にあるNew Channel をクリックして、RSSフィードのURIを入力するだけ。YouTube で試してみよう。

(参考)YouTube のRSSについて
タグで絞り込んだRSS
feed://www.youtube.com/rss/tag/[ここにタグ名を入力].rss
例) soccer
feed://www.youtube.com/rss/tag/soccer.rss

ユーザーで絞り込んだRSS
feed://www.youtube.com/rss/user/[ここにユーザー名を入力]/videos.rss

登録が完了すると、先ほどの真っ黒だった画面に今登録したチャンネルが表示される。


そして、そのチャンネルをクリックすると、こんな感じで動画の一覧が表示される。

見たい動画のサムネイルをクリックするとその動画を閲覧することができるってわけだ。

これだけだと、本当にただ試してみただけになってしまうので、この後何ができるのかちょこちょこ見ていきたいと思う。

僕もしゃべる @Yokohama.pm テクニカルトーク #3

このエントリーを含むはてなブックマーク hateb

■11/28(金) にYokohama.pm #3 が開催されます

Yokohama.pm テクニカルトーク #3 - Yokohama Perl Mongers
Yokohama.pm #3 スケジュール表( ← こっちのが最新情報 )

ボ会仲間のfujikake さんがしゃべるらしい
ボ会でのZIGOROuさんとのご縁
(というか「技術者は絶対にプレゼンでしゃべっておいた方がいいよ。
Yokohama.pmは初心者のための場だから」と力説され)
僕は、ZIGOROu さんにこんな教えを説いて頂いていない。僕のことをただのボードゲーム好きか、ただの親バカと思っているのかしら。もしかして、僕のことを技術者として認めていないとか!「キー!悔しいっー!」

以前、某所で、「○○のことをプログラマと呼ぶのはやめようよ。」
って言ってたのをなんだか思い出しちゃったよ。
(注、○○さんとZIGORuさんの関係上、これはdis にならないので、無問題発言です。)

■僕もしゃべる

というわけで(いや、というわけでもないんだけど)、とにかく適当なネタをしゃべることにした。ネタ候補はいくつかあって、最初はWeb上の画像収集に特化したWeb::Collector というものについてお話しようと思っていたんだけど、8割くらいがWeb::Scraper の話になっちゃいそうだったので、これはやめた。収集する様子を見るのも結構面白いので、LT枠でデモをやるのには良さそうなんだけど、Yokohama.pm の会場はネット環境が悪いとのことで、これもできそうにない。

(参考)
Web::Scraper を利用して画像をたくさん手に入れるWeb::Collector なんてものを書いた

それで、日頃から興味のある、「モンテカルロ法によるゲームAI」のようなものをしゃべることにした。興味の無い人にはまったくもってどうでもいい話なんだけど、技術者ならば誰しも多少の興味はあるんじゃないかという期待をこめて、このネタにした。

まあ、ここだけの話、正直、Perlは関係ない><
(実験のツールとしてPerl を使ってはいるけど)

ポイントをうまくまとめきれなかったため、20分枠でお願いさせて頂いたので、みなさんを退屈させないように頑張りたい。

■でも

Yokohama.pm 申込後に知ったんだけど、前日にShibuya.pm があるのか。
わざわざ関内に行くんじゃなくて、こっちで話せば良かったような気もする。

Web::Scraper を利用して画像をたくさん手に入れるWeb::Collector なんてものを書いた

このエントリーを含むはてなブックマーク hateb

■主な機能

1. YAML を書くだけで簡単に大量の画像を手に入れることができる。
2. 過去に取得した画像(ファイル名でチェック)は取得しない。
3. たどるページ数を制限できる。

1. がこのモジュールの主旨。
2. の機能があるおかげで、取得した画像を整理したり、いらないものを削除したりしても、もう一度同じ画像を取得してしまうことがない。
3. 最初に取得するときはたくさんのページをたどるようにしてスクリプトをキックし、その後例えばcron で定期的にまわす場合などは、たどるページを1とかにすると相手のサーバにも負担をかけなくて良い。

■使い方

1. YAMLを書く (config.yaml)
---

img_dir: /Users/junichiro/Pictures/e3
uri: http://www.e-3.ne.jp/image?p=
max_cnt: 1
process: process "p.member>a>img", 'img_uri[]' => [ '@src', sub { s/80x80/640x640/ } ]

こんな感じ

2. スクリプトを実行する
./collector.pl config.yaml

これだけ。これをcron でまわせば知らないうちに大量の画像をgetできる。

■設定ファイル(yaml)の簡単な解説

img_dir

これは画像を格納するディレクトリ。僕の場合、ここは一時的に取得するディレクトリにしておいて、取得した画像を整理した後は空っぽにして使っている。ただし、このディレクトリにある.already.yaml というファイルで、すでに取得した画像のリストを保持しているので、これは削除しないように注意してほしい。逆に、画像の再取得をしたいときは、.already.yaml をいじればよい。

uri

取得したサイトのURIの断片
あまり汎用性が無くて申し訳ないのだが、ページを制御する変数がURIの中にわかりやすく含まれている場合しか使えない。この例ではp=というところでページを制御している。汎用性は低いが、この形で結構行けるサイトも多かった。p=とかpage=とかid=とかpage_id=とか、こんな感じになっているのが多い。

max_cnt

たどるページ数
最初のうちは1とかで試すといい。

process

画像を取得するためのXPath でも書けばよろし。
今回の例では、こんな形のHTMLから画像を取得できる。
<p class="member">
<a href="/mypage/diary/detail/7370">
<img src="http://img01.e-3.ne.jp/diary/10000/80x80/0_2.jpg" class="image_list" alt="" />
</a>
</p>
<p class="member">
<a href="/mypage/diary/detail/7369">
<img src="http://img01.e-3.ne.jp/diary/10000/80x80/0_1.jpg" class="image_list" alt="" />
</a>
</p>

ただし、80x80というディレクトリにはサムネイル画像があって、640x640というディレクトリに大きい画像があるようだったので、そこは無名関数を使って置換している。その辺の細かい書き方は、Web::Scraper の使い方を調べてほしい。

■ソース

collector.pl
use FindBin;
use lib "$FindBin::Bin/lib";
use strict;
use warnings;
use Web::Collector;
use YAML::Syck;

my $yaml = $ARGV[0] || die "Usage: collector.pl [config.yaml]¥n";
my $c = new Web::Collector($yaml);
$c->run();

Web::Collector.pm
package Web::Collector;

use warnings;
use strict;
use Carp;
use YAML::Syck;
use File::Spec;
use File::Basename;
use LWP::Simple;
use URI;
use Web::Scraper;

use version;
our $VERSION = qv('0.0.1');

use base qw/Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(qw(conf already uri have_files exists skip_cnt max_cnt));

sub new {
my ( $class, $yaml_file ) = @_;
my $conf = LoadFile($yaml_file);
my $already = File::Spec->catfile( $conf->{'img_dir'}, '.already.yml' );
unless ( -e $already ) {
open my $fh, ">", $already;
print $fh "---¥n";
close $fh;
}
my $have_files = LoadFile($already);
$have_files = [] unless ( ref $have_files );
my $self = {
'conf' => $conf,
'already' => $already,
'uri' => $conf->{'uri'},
'have_files' => $have_files,
'exists' => {},
'skip_cnt' => 0,
'max_cnt' => $conf->{'max_cnt'},
};
bless $self, $class;
}

sub run {
my $self = shift;
$self->_init();
foreach ( 1 .. 2 ) {
my $baseuri = $self->uri . $_;
my $uris = $self->get_uris($baseuri);
$self->get_images($uris);
}
$self->_end();
}

sub _init {
my $self = shift;
$self->_cache;
}

sub _end {
my $self = shift;
DumpFile( $self->already, $self->have_files );
}

sub _cache {
my $self = shift;
if ( ref $self->have_files ) {
foreach ( @{ $self->have_files } ) {
$self->exists->{$_}++;
}
}
}

sub get_uris {
my ($self, $baseuri) = @_;
my $uri = URI->new($baseuri);
my $scraper = scraper {
eval $self->conf->{'process'};
};
my $result = $scraper->scrape($uri);
return $result->{img_uri};
}

sub get_images {
my ($self, $uris) = @_;
foreach (@$uris) {
$self->get_image($_);
last if ( $self->skip_cnt >= $self->max_cnt );
}
}

sub get_image {
my ($self, $u) = @_;
$u = URI->new($u) unless (ref $u);
my $basename = basename( $u->path );
my $file = File::Spec->catfile( $self->conf->{'img_dir'}, $basename );
if ( $self->exists->{$basename} ) {
print "Skip: $file";
$self->{skip_cnt}++;
}
else {
print "Get: $file";
getstore( $u, $file );
$self->add_have_file($basename);
}
print "¥n";
}

sub add_have_file {
my ($self, $file) = @_;
push( @{$self->have_files}, $file );
}

1;


ロリポブログのせいなんだけど、これをコピーしても使えないのでソースが欲しい方はcodereposからどうぞ。
http://svn.coderepos.org/share/lang/perl/Web-Collector/trunk/

ページをたどるところは、page= とかで決めうちでたどるのではなく、WWW::Mechanize とかでもっと賢くたどれるようにしたい。

[Perl]Shibuya.pm #9 (XS nite) のまとめ

このエントリーを含むはてなブックマーク hateb
ひさびさのPerl エントリー。
とはいえ、今回はXSが中心なので、Perlの話はほとんど出てこない。自分自身Cはほとんど書けないので、勉強のためにと思ったが、最後まで集中力が持たなかった感もある。そういうわけで、かなり中途半端なまとめになってしまう。

1. はじめてのXS - ハマリどころはココだ
hirose31 ( no curry, no life )

■なぜXSを書くのか
1. Cのライブラリを使いたいため。
(Perlで実装し直すのが面倒でしょ)
2. パフォーマンスアップのため
(例えば、Cache::Memcached::Fast とか)
3. Perl の内部をいじくり倒すため
(ヘンタイ上級者向け)

■参考になるドキュメント
1. perlxstut
(XS のチュートリアル)
2. perlxs
(XS のリファレンスマニュアル)
3. perlguts
(Perl の内部構造についての解説)
4. perlapi
(Perl のAPIのリファレンス)

■作成のために
h2xs を使う。
ちなみに、h2xsはトラディショナルなやりかた。
h2xs -A -n Mytest


いまは module-starter がいいんじゃないか。

わからないときはCPAN にあがっている他のXS モジュールを参考にするといい。
例えば、JSON::XS とか YAML::Syck とか。

■メモリ管理について
New* したものは Safefree() すべし。
newSV* したものは sv_free すべし。
デストラクタ DESTROY()とかでやるとよい。

■プロファイリング
valgrind --tool=callgrind + kcachegrind

■その他
互換性の問題
ppport.h で吸収できる。
Devel:PPPort を最新版にしてね。

■まとめ
XS って意外と簡単です。
C ライブラリをコールするだけなら簡単。

【感想】
ハマりどころは、夢中になりすぎるところだと思った。
なんだもXSでやりたくなってしまうような。
C ライブラリをコールするだけの目的でとりあえず最初は始めたらいいのだろう。


2. Perl5 Internals の世界にようこそ!
lestrrat
牧さん頑張れ。

まず、大前提として Perl っちゅうのは C で書かれてるよね。
だから、XS がわかると Perl をより深く知れる。

■ちょいめも
SV - スカラー
AV - 配列
HV - ハッシュ

■SV とは
Perl 変数の基本
なんでもはいる入れ物

SV がわかれば Perl はほとんどわかってしまう(6割)

■REFCNT のはなし
Perl はメモリ管理は良きように計らってくれる
XS は C なので自分で管理しなければならない。

■SvMAGIC
この辺から一気に話が分からなくなる><
とにかくお手本モジュールは HTML::Parser

■まとめ
1. XS は Perl と C をつなぐもの
2. すでに C でかかれているものに Perl からアクセスするためだけに使うのがベスト
3. アダプタを作る = XS を書く
4. GC 重要

【感想】
hirose31 さんの発表の続きとして、とても良い流れでわかりやすかった。
後半は自分の無知のために、しばらくぶっとんでしまったが、とにかくXS に触れてみようと思った。


3. Inside Ruby.pm

筑波大学心理学部

Perl から Ruby を呼び出す。

【感想】
ヘンタイ
心理学と何の関係が?


4. PerlOS
wakapon

高水準言語マシン
PerlMachine

■何からインスパイヤされたか
1. bootperl
- CPAN にある
- x86 がブートして、最初のプロセスでワンライナーが走る

2. Perl/Linux
- SourceForge にある

■設計方針
1. できる限りPerlで実現させる
2. 世の中にあるPerlのコードはすべて動くようにする。
3. 実行速度は気にしない

【感想】
面白そうだと思った。
組み込み系とかで使えるかも、とか。
ただ、まったく理解できなかったということは、正直に告白しておこう。


5. LT
省略

【感想】
やはり、みんな当然のようにオペコードを気にしてperlのソースを書いているようだった。
負けてらんない。


全体の感想。
情けないくらい理解できなかったけど、XS に対するモチベーションがあがったことだけでもよしとしよう。
zigorou さんに聞きたいことがあったけど、いなくて残念だった。
悪い風邪は早く直してくださいな。

「XS を書いたことがある人?」って聞かれたときに、手を上げている人がうらやましかった。
mizzy さんとか。

さあ、これからも頑張るか。

Site Validatorの作り方。

このエントリーを含むはてなブックマーク hateb
こないだ公開したSite Validatorの開発過程を解説しようと思っていたけど、少々面倒なので、ソースを晒してちょっとコメントするだけに留める。

簡単に動作原理を説明する。
0. validationを実行するためのworkerを起動させて待機させておく。
1. ブラウザからURIの入力を受け付ける。
2. workerにURIを渡して、後はworkerに仕事をさせる。
3. その間ブラウザ側は、結果ページとなるページに遷移させてリロード状態で待機させる。
4. ユーザーをリロード状態で待たせてる間にworkerが以下(5〜9)の仕事をする。
5. 受取ったURIをもとに、チェック対象となるURIを探索する。
6. 5で取得したURIをひとつづつW3Cのvalidation APIに渡す。
7. 6の結果をちまちまと配列にためていく。
8. できあがった配列を使ってTTで結果ページを生成する。
9. 先ほどリロードで待機していたページが8で生成したページになる。

肝となるのはGearmanの使い方。これはzigorouさんのところを参考にした。
■参考
http://labs.cybozu.co.jp/blog/yamaguchi/2007/04/gearman.html
zigorou++

0.のworkerの待機については上記ページを。
1.はただのフォームね。
2.からが重要だ。2と3を実現しているコードはこちら(validate.cgi)
use strict;
use warnings;
use Gearman::Client;
use Gearman::Task;
use Storable qw(freeze);
use CGI;
use Template;
use File::Spec;
use FindBin;
use LWP::Simple;

my $q = CGI->new;

# キューの登録
my $c = Gearman::Client->new;
$c->job_servers(qw/localhost/);
my $base_uri = $ARGV[0] || $q->param('uri') || die 'Usage Error';
my $file = &get_file_name($base_uri);
my $arg = freeze( { 'base_uri' => $base_uri, 'file' => $file } );
my $result_ref = $c->dispatch_background( "w3c", ¥$arg, {} );

# 結果ページ生成の準備
my $r = head($base_uri);
unless ( $r && $r->is_success ) {
print $q->header();
print "This URI($base_uri) is not exist!";
exit;
}

# 結果準備ページの生成
my $redirect = "http://www.e-3lab.com/w3c/$file";
my $vars = { 'uri' => $redirect };
my $tt = Template->new();
$file = File::Spec->catfile( $FindBin::Bin, $file );
$tt->process( 'templates/wait.tpl', $vars, $file );
chmod( 0666, $file );

print "Location: $redirect¥n¥n";

# 結果ページのファイル名を生成する
sub get_file_name {
my $file = shift;
$file =~ s!http://!!msgx;
$file =~ s![¥./]!_!msgx;
$file =~ s!_$!!msgx;
$file = "results/$file.html";
return $file;
}
zigorouさんの所を見て頂ければすぐわかるのだけれど、workerへの値渡しが面倒。それ以外は特に問題ないと思う。使っているモジュールはすべてCPANから手に入る。

続いて4〜9を制御している、今回の肝となるworker.plがこちら。
use strict;
use warnings;
use Gearman::Worker;
use Storable qw(thaw);
use FindBin;
use lib "$FindBin::Bin/lib";
use E3::W3C::Validator;
use HTML::LinkExtor::All;
use Template;
binmode( STDOUT, ":utf8" );

my $w = Gearman::Worker->new;
$w->job_servers(qw/localhost/);
$w->register_function(
w3c => sub {
my $job = shift;
my $arg = thaw( $job->arg );
my $limit = 100;

# チェックするURIの洗い出し
my $base_uri = $arg->{'base_uri'};
my $file = $arg->{'file'};
my $ct = $arg->{'content_type'} || 'text/html';
my $html = HTML::LinkExtor::All->new( $base_uri, $limit );
my $links = $html->get_all_links($base_uri);
$links = $html->filter($ct);

# Validate 実行
my $v = E3::W3C::Validator->new( $links, $limit );
my $results = $v->validate;
my $count = $v->count;
my $vars = { 'results' => $results, 'c' => $count };
my $tt = Template->new(
LOAD_TEMPLATES => [ Template::Provider::Encoding->new ],
STASH => Template::Stash::ForceUTF8->new,
);
$tt->process( 'templates/result.tpl', $vars, $file );
}
);
$w->work while 1;


まずは事前処理部分。
my $job   = shift;
my $arg = thaw( $job->arg );
my $limit = 100;

先ほど少し触れたworkerへの値渡しの部分が2行目。
3行目はリンクを100までで打ち切るための設定部分。

それでは最初に挙げたステップとコードを対応させてみよう。
(5. 受取ったURIをもとに、チェック対象となるURIを探索する。)
# チェックするURIの洗い出し
my $base_uri = $arg->{'base_uri'};
my $ct = $arg->{'content_type'} || 'text/html';
my $html = HTML::LinkExtor::All->new( $base_uri, $limit );
my $links = $html->get_all_links($base_uri);
$links = $html->filter($ct);

まず、HTML::LinkExtor::ALLで与えられたURIからどんどんページをたどってリンクされているURIを抜き出していく。このHTML::LinkExtor::ALLはCPANにあるHTML::LinkExtorをbaseに作った、自作モジュール。$limitはオプションで、これを与えなければデフォルトで50ページまでに制限する。今回はこれを100にしてある。これが1〜4行目。

5行目で、取得したURIのcontent_typeに応じてフィルタリングしている。今回はtext/htmlしか必要ないので、それ以外は除外している。100ページ制限のあとにこのフィルタをかましているのがちょっと失敗した部分。

(6. 5で取得したURIをひとつづつW3Cのvalidation APIに渡す。)
# Validate 実行
my $v = E3::W3C::Validator->new( $links, $limit );

E3::W3C::ValidatorというのはCPANにあるWebService::Validator::HTML::W3Cをbaseに拡張した自作モジュール。複数のURIに対応したり、結果をカウントできたりする機能を追加している。
(7. 6の結果をちまちまと配列にためていく。)
my $results = $v->validate;
my $count = $v->count;
my $vars = { 'results' => $results, 'c' => $count };

(8. できあがった配列を使ってTTで結果ページを生成する。)
(9. 先ほどリロードで待機していたページが8で生成したページになる。)
my $file    = $arg->{'file'};
my $tt = Template->new();
$tt->process( 'templates/result.tpl', $vars, $file );


とりあえずこんなところ。
もし、万が一、ご要望があればHTML::LinkExtor::ALLなどもソースを晒して解説してみようと思う。

htmlのcharsetとソースの文字コードを比較してチェックするスクリプト

このエントリーを含むはてなブックマーク hateb
僕の大好きなFile::Findを使って、特定のディレクトリ以下にあるすべてのhtmlファイルを対象に、metaにセットされているcharsetが正しいかをチェックするスクリプト。

精度は完璧ではないけど、これでcharsetが指定されていないファイルをリストアップしたり、charsetと実際の文字コードが一致していないだろうと思われるファイルををリストアップすることができる。

使い方はこのスクリプトを適当なところにアップしてコマンドラインから実行するだけ。
最初の引数は調べたいディレクトリ、2番目の引数は調査対象のファイルの正規表現。
2番目の引数は省略可能で、その場合ファイル名の最後がhtmlまたはhtmで終わっているものだけが対象になる。
#!/usr/bin/perl

use strict;
use warnings;
use File::Find;
use Encode::Guess;

my ( $dir, $suf ) = @ARGV;
$suf = ($suf) ? qr($suf) : qr(¥.html?$);
my @results;

$dir ||= '/Users/tobe/Sites';

find( ¥&wanted, ($dir) );
&show( ¥@results );

sub wanted {
return unless (m/$suf/);
my $file = $File::Find::name;
my $result = &get_charset($file);
$result->{'file'} = $file;
push( @results, $result );
}

# 文字コードを取得
sub get_charset() {
my $file = shift;
open my $fh, "<", $file;
local $/;
my $data = <$fh>;
close $fh;
my $charset = &_get_meta_charset($data);
my $enc = &_get_src_charset($data);
my $check = ( $charset eq $enc ) ? 'OK' : 'NG';
return { 'html' => $charset, 'src' => $enc, 'check' => $check };
}

# html内のmetaタグから文字コード取得
sub _get_meta_charset() {
my $data = shift;
my $charset = q();
$charset = lc($1) if ( $data =~ m/charset=([¥w¥-]*)/msix );
return $charset;
}

# ソースから文字コードを類推
sub _get_src_charset() {
my $data = shift;
my $enc = q();
my $guess =
Encode::Guess::guess_encoding( $data, qw/utf8 euc-jp shiftjis/ );
$enc = $guess->name if ( ref $guess );
$enc =~ s/shiftjis/shift_jis/msix; # metaタグと同じ文字
$enc =~ s/utf8/utf-8/msix; # コード名になるように調整
return $enc;
}

# 表示
sub show() {
my $results = shift;
foreach my $result (@$results) {
print
"$result->{'file'},$result->{'html'},$result->{'src'},$result->{'check'}¥n";
}
}


2008/02/07 追記
ここにスクリプトを書いただけじゃ使えないことに気がついた。
これをコピペして使ってもらおうと思ってたんだけど、それじゃだめだった。(ロリポのバカバカ!)

というわけでダウンロードできるようにした。
拡張子は適当に変えて。(ダウンロード用に.pmとしていますが、.plなどに変えてくれろ。)
charset_checker.pm

出力結果例
/Users/tobe/Sites/index.html,shift_jis,shift_jis,OK
/Users/tobe/Sites/news_sample.html,utf-8,utf-8,OK

これをcsvとして保存してExcelなどでチェックすればよい。
後は、charsetがセットされていないファイルや、結果がNGになっているファイルだけをじっくりと手で調査すれば良い。