Txじゃないのは、Txはまだちょっとインターフェイスが少なかったから。でも余裕があればText::Txとかも作ってみたいところ。

Darts #0.31以降をインストールしてから、普通にmakeしてください。

use Text::Darts; 
my $td     = Text::Darts->new(qw/ALGOL ANSI ARCO ARPA ARPANET ASCII/);
my $newstr = $td->gsub("ARPANET is a net by ARPA", sub{ "<<$_[0]>>" });
# $newstr is now "<<ARPANET>> is a net by <<ARPA>>".
# or
my $td     = Text::Darts->open("words.darts");
my $newstr = $td->gsub($str, sub{ 
 qq(<a href="http://dictionary.com/browse/$_[0]">$_[0]</a>)
}); # link'em all!

見てのとおり、単語のリストを与えてその場でdartsも作れますし、mkdartsしたdartsファイルを読み込むことも出来ます。あとは見てのとおりです。

きまぐれ日記: はてなキーワードを高速に付与 (SWIG を使って Perl モジュール)にあるように、はてなキーワードリンクのSWIGバージョンはKudohさんご本人が作ってらっしゃっているのですが、こちらの方が使い勝手がいいと思います。

普通にRegexpした場合と比較したBenchmarkも取ってみました。Benchmarkスクリプト自身に含まれる単語を全て見つけて置換しています。

Benchmark: running Darts, Naive, R::A for at least 3 CPU seconds...
     Darts:  4 wallclock secs ( 3.45 usr +  0.09 sys =  3.54 CPU) @ 1546.45/s (n=5473)
     Naive:  3 wallclock secs ( 3.02 usr +  0.00 sys =  3.02 CPU) @ 555.77/s (n=1676)
      R::A:  3 wallclock secs ( 3.34 usr +  0.00 sys =  3.34 CPU) @ 387.59/s (n=1296)
        Rate  R::A Naive Darts
R::A   388/s    --  -30%  -75%
Naive  556/s   43%    --  -64%
Darts 1546/s  299%  178%    --

Benchmark: running Darts, Naive, R::A for at least 3 CPU seconds...
     Darts:  3 wallclock secs ( 3.14 usr +  0.08 sys =  3.22 CPU) @ 1118.63/s (n=3602)
     Naive:  3 wallclock secs ( 3.06 usr +  0.02 sys =  3.08 CPU) @ 843.83/s (n=2599)
      R::A:  3 wallclock secs ( 3.23 usr +  0.01 sys =  3.24 CPU) @ 538.89/s (n=1746)
        Rate  R::A Naive Darts
R::A   539/s    --  -36%  -52%
Naive  844/s   57%    --  -25%
Darts 1119/s  108%   33%    --

あらためてKudohさんに感謝しつつ、Enjoy!

Dan the Perl Monger

#!/usr/local/bin/perl
use strict;
use warnings;
use Text::Darts;
use Regexp::Assemble;
use Benchmark qw/cmpthese timethese/;

my $str = do { open my $fh, __FILE__; local $/; my $s = <$fh>; close $fh; $s };
my @words = do { my %h; $h{$_}++ for split /\W+/, $str; keys %h };

my $td = Text::Darts->new(@words);
my $ra = Regexp::Assemble->new;
$ra->add($_) for @words;
my $re_ra = $ra->re;
my $re_nv = do{ my $str = join '|', @words; qr/(?:$str)/  };

cmpthese( timethese( 0,
      {
          Darts => sub {
              $td->gsub( $str, sub { "<$_[0]>" } );
          },
          'R::A' => sub {
              my $tmp = $str;
              $tmp =~ s{ ($re_ra) }{ "<$1>" }msgex;
          },
          'Naive' => sub {
              my $tmp = $str;
              $tmp =~ s{ ($re_nv) }{ "<$1>" }msgex;
          },
      } ) );