メールアドレスを抽出する部分の処理に時間がかかっている。 置き換えつつループをまわすのを改め、一括置き換えの中でループ内で行なっていた処理を行うようにしたところ、改善された。
以下のコードを実行すると、ループの場合は非常に長い時間がかかることがわかる。
#!/usr/bin/perl use strict; use warnings; my $test_to = 'foo@example.com, <bar@example.com>, '; use Benchmark qw(timethese cmpthese); cmpthese( 100, { 'test_113' => 'test_113', 'test_114' => 'test_114' } ); sub test_113 { my $argument = $test_to x 8000; my %words; while ( $argument =~ s/<([[:alpha:]0-9\-_\.]+?@([[:alpha:]0-9\-_\.]+?))>// ) { $words{$1}++; } while ( $argument =~ s/([[:alpha:]0-9\-_\.]+?@([[:alpha:]0-9\-_\.]+))// ) { $words{$1}++; } } sub test_114 { my $argument = $test_to x 8000; my %words; $argument =~ s{<([[:alpha:]0-9\-_\.]+?@([[:alpha:]0-9\-_\.]+?))>}{ # PROFILE BLOCK START $words{$1}++; ''; }egsx; # PROFILE BLOCK STOP $argument =~ s{([[:alpha:]0-9\-_\.]+?@([[:alpha:]0-9\-_\.]+))}{ # PROFILE BLOCK START $words{$1}++; ''; }egsx; # PROFILE BLOCK STOP } 1;
実行結果
s/iter test_113 test_114 test_113 4.58 -- -100% test_114 2.19e-02 20821% --
なんと、修正版のほうが 200 倍も速い!