taichino.com » perl

[perl] ハッシュのスライスと多次元ハッシュのエミュレーション

taichino — Thu, 28 Jan 2010 10:09:12 +0000

XML::Simpleのコードを読んでいると以下の様な表現が頻繁に出てきました。問題は8行目なのですが、ハッシュをリストコンテキストで扱っているのですが、初めて見る表現で、調べるのにも少し手こずったのでメモしておきます。

#!/usr/bin/perl
 
use Perl6::Say;
use YAML;
 
my @keys = qw(key1 key2);
my @vals = qw(val1 val2);
@dic{@keys} = @vals;   # 問題の行
say Dump \%dic;
 
# 出力は以下のようになります
# ---
# key1: val1
# key2: val2

結論から言えば、これはハッシュのスライスと呼ばれる表現で、配列のスライスと同様にハッシュの部分要素群を一度に扱う事ができます。上記の例では@が多数出てきて紛らわしいのですが、解り易く書くと以下のようになります。

#!/usr/bin/perl
 
use Perl6::Say;
use YAML;
 
my @keys = qw(key1 key2);
my @vals = qw(val1 val2);
@dic{'key1', 'key2'} = @vals;   # 問題の行
say Dump \%dic;

このようにハッシュに対して@とブレース内でのキーを指定すると、ハッシュのスライスが扱えます。違和感があったのはハッシュをリストコンテキストで扱いながら、キーを同時に書いていた事なのですが、恥ずかしながら単純に知らないだけでした。それにしても、これは便利ですね。ちなみにpythonの辞書では使えません。残念です。

ところで紛らわしい事にハッシュの複数キーを扱う表現があります。例えば以下のコードを見て下さい。

#!/usr/bin/perl
 
use Perl6::Say;
use YAML;
 
my %scores;
$scores{'taichino', 'math'} = 60;
$scores{'taichino', 'english'} = 40;
$scores{'mamino', 'math'} = 50;
$scores{'mamino', 'english'} = 80;
 
say $scores{'taichino', 'math'};   # 60
say $scores{'mamino', 'english'};  # 80

違いはハッシュのプリフィックスが@では無く$です。プログラミングPerlによるとこれは、多次元ハッシュのエミュレーションと呼ばれているようです。複数キーに対して値をマッピングしているので、確かに疑似多次元ハッシュとして使えますが、現在は使われていないようです。紛らわしいですね。

というわけで、まとめは以下になります。

ハッシュのスライス
@hash{key1,key2…}
多次元ハッシュのエミュレーション
$hash{key1, key2…}

ハッシュのスライスは便利なのでガンガン使って行きたいですね。

CoroとthreadsとForkManagerでウェブページ取得の比較をしてみた

taichino — Fri, 16 Oct 2009 09:14:02 +0000

以前Coroで効率よくスクレイピングなどと書いたんですが、恥ずかしながら書いた時はCoroがコルーチンを意味しているとは知らず、マルチスレッドを扱うライブラリだと認識していました。もう少し理解したいという事で、以下の３つの方法で並列にHTTPリクエストを発行して、その比較を行ってみました。

Coroによるマルチスレッド処理
threadsによるマルチスレッド処理
ForkManagerによるマルチプロセス処理

テストしてみたのは以下のコードです。Coroだけ別なのはCoro::LWPをインポートすると、LWPが全部Coro仕様に上書きされる為です。処理は、はてなブックマークのホットエントリのリストを取得して、リストのそれぞれのページへアクセスしてタイトルを取得するというものです。

#!/usr/bin/perl
 
use strict;
use warnings;
use Perl6::Say;
use YAML;
 
use Time::HiRes;
use threads();
use LWP::Simple;
use Web::Scraper;
use Parallel::ForkManager;
use IPC::Shareable;
use Benchmark qw(timethese cmpthese);
 
my @links = test_urls();        # ホットエントリのURLリストを取得して、
my $result = timethese(10, {    # それぞれの方法で各URLのタイトルを取得するのを計測する
	'single'       => sub { do_sthread(\@links);  },
	'multi_thread' => sub { do_mthread(\@links);  },
	'fork_manager' => sub { do_mprocess(\@links); }
});
cmpthese($result);
exit;
 
# はてなブックマークから現在のホットエントリーのURLリストを取得
sub test_urls {
	my $source  = "http://b.hatena.ne.jp/hotentry";
	my $scraper = scraper {
		process '//div[@class="entry-body"]/h3/a', 'links[]' => '@href';
	};
	return @{$scraper->scrape(get($source))->{'links'}};
}
 
# 指定したURLにあるページのタイトルを取得する
sub get_title {
	my $url = shift;
	my $scraper = scraper {
		process '//title', 'title' => 'TEXT';
	};
	return $scraper->scrape(get($url))->{'title'};
}
 
# シングルスレッドでリクエストを発行
sub do_sthread {
	my $links = shift;
	my $t1 = Time::HiRes::time;
 
	my @result;
	foreach my $link (@$links) {
		push(@result, get_title($link));
	}
 
	say "Single Thread Time took: ", Time::HiRes::time - $t1;
	return @result;
}
 
# マルチスレッドでリクエストを発行
sub do_mthread {
	my $links = shift;
	my $t1 = Time::HiRes::time;
 
	my @threads = map {
		threads->create(\&get_title, $_);
	} @$links;
 
	my @result;
	push (@result, $_->join) for @threads;
 
	say "Multi Thread Time took: ", Time::HiRes::time - $t1;
	return @result;
}
 
# Paralell::ForkManagerで並列処理
sub do_mprocess {
	my $links = shift;
 
	my $t1 = Time::HiRes::time;
	my $pm = Parallel::ForkManager->new(10);
	my $handle = tie my @result, 'IPC::Shareable', undef, { destroy => 1 };
	@result = ();
	for my $link (@$links) {
		$pm->start and next;
		my $title = get_title($link);
		$handle->shlock;
		push(@result, $title);
		$handle->shunlock;
		$pm->finish;
	}
	$pm->wait_all_children;
	say "Multi Process Time took: ", Time::HiRes::time - $t1;
	return @result;
}

以下はCoroのテスト。一部省略。

use Coro;
use Coro::LWP;
 
sub do_coro {
	my $links = shift;
	my $t1 = Time::HiRes::time;
 
	my (@coro, @result) = (), ();
	for my $link (@$links) {
		push @coro, async {
			push @result, get_title($link, 1);
		};
	}
	$_->join for @coro;
	say "Coro Time took: ", Time::HiRes::time - $t1;
	return @result;
}

で、結論をはしょって書くと以下のようになりました。singleというのはリクエストを並列化せずに行ったものです。

fork_manager: 313 wallclock secs ( 0.11 usr 0.59 sys + 159.14 cusr 30.70 csys = 190.54 CPU) @ 14.29/s (n=10)
multi_thread: 250 wallclock secs (179.52 usr + 10.47 sys = 189.99 CPU) @  0.05/s (n=10)
coro:         220 wallclock secs (118.99 usr +  3.32 sys = 122.31 CPU) @  0.08/s (n=10)
single:       714 wallclock secs (127.31 usr +  4.17 sys = 131.48 CPU) @  0.08/s (n=10)

予想に反して、coroがwallclockを見てもCPU負荷を見ても性能が良いと出ています。(個人的にはthreadsが一番早いと思っていました。)厳密に測定してないので、あくまで参考程度ですが。

以上で、結論としてはソースコードも短くて簡潔ですし、コルーチン的な機能は何も使ってないけど、Coroをクローラ用途で使ってもいいじゃない！ってところです。あとテストコードはこれです。

PadWalkerでmy変数のシンボルテーブルを取得する

taichino — Thu, 15 Oct 2009 07:36:49 +0000

最近perlのスタッシュと言う単語を覚えました。所謂パッケージスコープのシンボルテーブルで特定のパッケージ内に定義されている関数や変数の情報を得る事が出来ます。詳細は以下のページが解り易かったです。

wakaponさんの備忘帳

さて問題は何かというと、上記ページにも書かれているように、my変数がスタッシュではなく、別のスクラッチパッドと呼ばれる領域に格納されるため、スタッシュからはアクセスできないという事です。

定義されているmy変数のリストも取得したいと思い調べてみると、PadWalkerというモジュールに行き着きました。このモジュールを使うと、なんとスクラッチパッドの読み書きが出来ます。例えば以下のようにして使用します。

#!/usr/bin/perl
 
use strict;
use warnings;
use PadWalker qw(peek_my peek_our);
use Data::Dumper;
 
my $scalar = "hello";
my @list   = (1,2,3);
our %hash  = (item1 => 'val1', item2 => 'val2');
print Dumper peek_my(0);   # このスコープで定義されているmy変数のハッシュを見る
print Dumper peek_our(0);  # our変数を見る事も出来る
 
# ハッシュ経由で変数を弄る事も出来る
${peek_my(0)->{'$scalar'}} .= " world";
print $scalar . "\n";      # hello world

上記プログラムのpeek_my(0)のダンプ結果は以下のようになります。ばっちり思った結果が得られていますね。

$VAR1 = {
          '$scalar' => \'hello',
          '@list' => [
                       1,
                       2,
                       3
                     ]
        };

これでスタッシュ経由でグローバル変数、スクラッチパッド経由でmy変数を、それぞれハッシュで得られるようになりました。だから何だという話もありますが、僕はperlのビギナーなので、Cやjavaの感覚でperlのプログラムを書いて、挙動が思ったようにならない事がよくあります。そんな時にシンボルテーブルどうなってるの？と確認できるのは結構便利です。ここ数時間あれこれダンプしすぎて作業が進みませんが。。

さておまけですが、このPadWalkerを使うと別のスコープのmy変数にアクセスできます。

sub modify_var {
	my $var_name = shift;
	# peek_my(1)で一つ上のスコープのスクラッチパッドにアクセスできる。
	${peek_my(1)->{$var_name}} = "modified";
}
my $data = 'new data';
modify_var('$data');
print $data . "\n";   # modified

こんな事されるとレキシカルスコープ危うしですね。使い道も今のところ思いつきません。

perlでモジュールのimportとunimport

taichino — Thu, 15 Oct 2009 00:33:39 +0000

perlでモジュールをインポートする時に何気なく使ってるuse Hogeですが、調べてみると少し思ってたのと違ってたので、調べた事をメモしておきます。

use Hogeは実は標準関数useの呼出しを行っていて、その内容は以下と同等です。

BEGIN {
    require Hoge;  # 中で更にdo Hoge.pmを呼び出す
    import Hoge;   # Hoge::importを実行
}

require Hogeは対応する.pmファイルを読み込み、importはHoge::importを呼び出します。requireされた時点でロードは完了して、Hoge.pmに定義されている関数等は使用可能です。じゃあimportで何をしてるかというと、読み込み元パッケージの名前空間にHoge.pm内の関数に対するエイリアスを定義する為に使われる事が多いようです。

逆にモジュールをunimportしたい場合はno Moduleを使います。no ModuleとするとModule::unimportが呼び出されます。no strict ‘refs’等はよく見かけますね。ここで注意したいのはno Moduleを呼び出したからといってModuleが無効化されるとは限らないという事です。あくまでもModule::unimportが呼ばれるだけです。またunimportが実装されていないモジュールに対しては何も起こりません。

という事は一度importしてしまうとunimportできない場合も多いので、そもそもimportしたくないという状況がたまにあります。そういう時はどうすれば良いかというと、use Hoge()を使います。Hogeの後に括弧が付くとimportが呼ばれず以下と等しくなります。

BEGIN {
    require Hoge;
}

どういう時に使うのかというと、別々のモジュールから同じ名前の識別子がimportされてしまうのを回避するのに使えます。例えばthreadsとCoroにはasyncという関数が定義されていて、同一パッケージ内で一緒にuseするとエラーがでるわけですが、use threads()、use Coro()とする事でエラーを回避できます。他にも使い道があるかもしれませんが、今のところ思いつきません。あったら教えて下さい。

#!/usr/bin/perl
 
package import_test;
use threads;
use Coro;       # ここでエラーが出る。エラー内容は以下。
# Prototype mismatch: sub import_test::async (&;@) vs (&@) at /Library/Perl/Updates/5.8.8/Exporter.pm line 67.
 
package main;
use threads();  # importさせなければエラーは出ない
use Coro();

ところで、useはBEGINブロックに置き換わると等しいと書きましたが、本当かどうか解らなかったので、確認したいなぁと思って探しているとDeparseというモジュールを使うと良いと解りました。試しに以下のコードをperl -MO=Deparse,-x5 test.plとしてみましょう。

use threads();   # importなし
use Coro;         # importあり

そうすると以下の様な出力が得られます。Deparseはスクリプトの解析結果を出力するモジュールで、-xオプションで指定する出力レベルを上げると、より内部構造に近い形でスクリプトを見る事が出来ます。実際にBEGINブロックが得られていて、threadsのimportが呼ばれず、Coroのimportが呼ばれている事も確認できますね。

sub BEGIN {
    require threads;
    do {
        ()
    };
}
sub BEGIN {
    require Coro;
    do {
        'Coro'->import
    };
}

まとめ

perlのuseは他の言語とは違って、標準関数の１つ。perldoc -f use参照
use Module、no Moduleされた時の挙動もモジュールに依存してる。
なんか変だと感じたらとりあえずDeparse、その後モジュールのimportのコードを読む。

[メモ] TheSchwartzのサンプルコード

taichino — Sun, 11 Oct 2009 09:44:14 +0000

遅まきながらJobキューを使いたくて、あれこれかじっています。perlだとTheSchwartzがメジャーな雰囲気だったので試してみました。

準備
まずjobキュー用のデータベースを準備します。上記ページには説明がありませんが、スキーマもCPANにあがっています。ここではtheschwartzという名前のデータベースをdb_userユーザから使っています。

$ wget http://search.cpan.org/src/BRADFITZ/TheSchwartz-1.07/doc/schema.sql
$ mysqladmin -u root create theschwartz
$ mysql -u root theschwartz < schema.sql
$ mysql -u root
> grant all on theschwartz.* to db_user@localhost identified by 'db_pass';

ジョブの追加処理
まずキューにジョブを追加します。ジョブの追加はTheSchwartz本体でも出来ますが、不要なオブジェクトのロードが走らないのでTheSchwartz::Simpleを使うのが良いようです。

#!/usr/bin/perl
 
use strict;
use warnings;
use Perl6::Say;
 
use DBI;
use TheSchwartz::Simple;
 
my $dbh = DBI->connect('dbi:mysql:theschwartz', 'db_user', 'db_pass');
my $client = TheSchwartz::Simple->new($dbh);
my $id = $client->insert('SampleWorker', {'data' => @ARGV ? $ARGV[0] : 10});
 
say "job $id is inserted";

ジョブを実行する処理
ジョブの実行はTheSchwartz本体で行います。TheSchwartz::Workerのサブクラスでジョブの実行処理を記述し、そのクラスを$TheSchwartz->can_doで指定します。後は$TheSchwartz->workでひたすらキューに入ったジョブを実行し続けてくれます。下記コードでは実行した事をログに残すだけのジョブを処理しています。

#!/usr/bin/perl
package SampleWorker;
 
use strict;
use warnings;
 
use base qw(TheSchwartz::Worker);
 
use Perl6::Say;
use IO::File;
 
sub work {
	my ($class, $job) = @_;
 
	say "working";
	my $file = IO::File->new;
	$file->open('work.txt', 'a') or die $!;
	$file->print($job->arg->{'data'} . " is done\n");
	$file->close();
 
	$job->completed();
}
 
package main;
use strict;
use warnings;
use TheSchwartz;
 
my $worker = TheSchwartz->new(
	databases => [{
		dsn  => 'dbi:mysql:theschwartz',
		user => 'db_user',
		pass => 'db_pass'
	}]);
$worker->can_do('SampleWorker');
$worker->work();

割とシンプルに使えていいですね。TheSchwartzってネーミングがよく解りませんけども。
後でQ4Mと使い比べてみようと思います。