Perl で、メールアドレスの自動リンクをする

以下のサブルーチン getEmails で抜き出したテキスト中のメールアドレス一覧を emailToLink が配列で受け取る。getEmails 中の　while はヘタすると無限ループに陥る可能性があるので変換対象のテキストで 50個まで抜き出すようにしている。使用するモジュール

なし

#!/usr/bin/perl

sub getEmails {

    my $text = shift;
    my @emails;

    my $email_regex =
      q{(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥}
    . q{¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][}
    . q{^¥¥¥¥¥x80-¥xff¥n¥015"]*)*")(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x}
    . q{80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-}
    . q{¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][^¥¥¥¥¥x80-¥xff¥n¥015"]*)*"))*@(?:[^(}
    . q{¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥0}
    . q{00-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[^¥x80-¥xff])*}
    . q{¥])(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,}
    . q{;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[}
    . q{^¥x80-¥xff])*¥]))*};

    my $i = 0;
    while($text =~ /($email_regex)/o && $i++ < 50) {
        push(@emails, $1);
        $text =~ s/$1/XXXXXXXXXX/g;
    }

    return @emails;
}

sub emailToLink {

    my $text = shift;
    my @emails = &getEmails($text);

    foreach my $email (@emails) {
        $text =~ s/$email/<a href=mailto:$email>$email<¥/>/g;
    }

    return $text;
}

1;