Perlメモ

sub my_flock { my %lfh = (dir => './lockdir/', basename => 'lockfile', timeout => 60, trytime => 10, @_); $lfh{path} = $lfh{dir} . $lfh{basename}; for (my $i = 0; $i < $lfh{trytime}; $i++, sleep 1) { return \%lfh if (rename($lfh{path}, $lfh{current} = $lfh{path} . time)); } opendir(LOCKDIR, $lfh{dir}); my @filelist = readdir(LOCKDIR); closedir(LOCKDIR); foreach (@filelist) { if (/^$lfh{basename}(\d+)/) { return \%lfh if (time - $1 > $lfh{timeout} and rename($lfh{dir} . $_, $lfh{current} = $lfh{path} . time)); last; } } undef; } sub my_funlock { rename($_[0]->{current}, $_[0]->{path}); } # ロックする(タイムアウトあり) $lfh = my_flock() or die 'Busy!'; # アンロックする my_funlock($lfh);

複数のプロセスが同時にある 1つのファイルを読み書きする可能性がある場合，排他制御をしなければなりません．排他制御をする方法はいくつかありますが，このスクリプトは次の方針に基づいています． (一)どんなプラットフォームでも使えること (二)異常なロック状態を回避できること排他制御をする方法として flock 関数や symlink 関数を使う方法がありますが，これらの関数はプラットフォームによってはサポートされていません．したがって，1を満たすためにはこれらの方法を使うことはできません．それ以外の方法としては， mkdir 関数を使う方法と rename 関数を使う方法が考えられます．次に2についてですが，異常なロック状態とは，あるプロセスがロックした状態のまま何らかの原因で死んだ場合に，ロックが解除されずに残ってしまった状態のことです． flock を使っている場合は，ロック状態でプロセスが死んだとき自動的にロックが解除されますので，異常なロック状態は起こりません．しかし， symlink や mkdir， rename などを使う場合にはスクリプト側での対処が必要になります．具体的にどのように対処するかですが，ロック状態がある一定の時間を経過していた場合には異常と判断し，他のプロセスがロック状態を解除してもよいことにします．実はここに落とし穴が存在します．排他制御をする方法としてなぜ symlink や mkdir， rename を使うのか？それはこれらの関数が，ロックできるかどうかのテストと実際にロックする操作を同時に行なうことができる atomic な関数であるからです．話を戻して，異常なロック状態を解除するときのことを考えます．たとえば， mkdir を使ったロックの方法において，異常なロック状態のときにロックを解除するには，次のようなスクリプトになります．

rmdir($lockdir) if (time - (stat($lockdir))[9] >60);

ロック状態が 60秒以上経過していた場合にはロックを解除するというスクリプトですが，これが symlink や mkdir， rename のときと違って，ロックを解除するかどうかの判断と実際にロックを解除する操作を同時に行なっているわけではないということが問題となります．具体的に何がまずいのかというと，正常なロック状態も解除してしまうことがあるということです．それは次のような場合です．

プロセスＡ	プロセスＢ	プロセスＣ
異常と判断	異常と判断	↓
↓	↓	↓
ロック解除	↓	↓
↓	↓	ロック
↓	ロック解除	↓

複数のプロセスでロック状態が異常であると判断し，そのうちの 1つがロックを解除したことにより，別のプロセスがロックしたにもかかわらず，先ほどロック状態が異常であると判断したプロセスによってこの正常なロックを解除されてしまう可能性があります．この方法の問題点は，異常なロック状態を解除する操作が正常なロック状態をも解除できてしまうことにあります．逆に言えば，異常なロック状態を解除する操作によって正常なロック状態を解除できなければ問題ないわけです．そのためにはどうすればよいのか？答えはロック状態が常に変化していけばよいということです．そして，これを実現するのに都合がよいのが rename による方法になります．最初のスクリプトで説明しますと，ロックファイルが lockfile という名前のときがロックが解除されている状態で，lockfile987654321 のように後ろに作成時刻がついた状態がロック状態になります．こうすることで先ほどの例で，プロセスＢによってプロセスＣのロックが解除されてしまったという状況を回避することができます．なぜなら，プロセスＣによって rename されたロックファイルの名前はすでにプロセスＢが知っている名前とは違っているからです．最初のスクリプトでは一旦ロックを解除するのではなく，異常なロック状態を解除しつつ，新たなロック状態へと移行させています．スクリプトの注意点としては，あらかじめロック用のディレクトリとファイルを用意しておくこと，ディレクトリに書き込み属性をつけておくこと， dir の値には最後に / などのデリミタをつけておくことです． $lfh = my_flock(basename => 'lockfileA'); のように呼び出すことでパラメータを変更できます．また，my_flock() はロックに失敗(タイムアウト)すると undef を返します．ロックするまでブロックしたい場合には次のように書きます． # ロックする(タイムアウトなし) 1 while (not defined($lfh = my_flock()));
最後に，ファイルを読み込み，それを加工した上で書き込む場合の安全な排他制御の手順を書いておきます． (一)ロックする (二)ファイルを読み込む (三)一時ファイルに書き込む (四)一時ファイルを元ファイルにリネームする (五)アンロックするトップへ

ファイルの中身を逆順に表示する

# ファイル $file の中身を逆順に表示する $bufsize = 1024; open(FILE, "< $file"); binmode(FILE); $size = (-s FILE) / $bufsize; $pos += $size <=> ($pos = int($size)); while ($pos--) { seek(FILE, $bufsize * $pos, 0); read(FILE, $buf, $bufsize); $buf .= $buf_tmp; ($buf_tmp, @lines) = $buf =~ /[^\x0D\x0A]*\x0D?\x0A?/g; pop(@lines); foreach (reverse @lines) { print $_; print "\n" if $_ !~ /[\x0D\x0A]$/; } } close(FILE); print $buf_tmp;
このスクリプトはファイルを $bufsize バイトずつ読み込んで逆順に表示するので，ファイル全体を一度に読み込む方法に比べて少ないメモリで実行させることができます． $size への代入文にある -s はファイルテスト演算子の 1つでファイルサイズを返します． $pos にはファイルサイズを $bufsize で割って切り上げた値が代入されます．切り上げに関しては﹁数字を切り上げる﹂を参照してください． while ブロックは $pos 回に分けてファイルを読み込んで処理するということをやっています． $buf には $bufsize バイトずつ読み込んだファイルの一部が代入されます．ファイルの中身を逆順に表示するためには，まずは $buf の中身を行ごとに分ける必要があります．それを行なっているのが $buf =~ /[^\x0D\x0A]*\x0D?\x0A?/g; の部分になります．この正規表現は，改行コード以外の文字が 0文字以上続き，その後の改行コードまでを表わしています．つまり，これで 1行分を取り出しているわけです．改行コード以外の文字が 0文字以上であるので空行にもマッチします．また，改行コードの部分の正規表現 \x0D?\x0A? は改行コードが \x0D\x0A でも \x0D でも \x0A でもよいことはもちろんのこと，ファイルの最後が改行で終わっていない行だった場合にもマッチします．ここまでの話ですでにお気づきの人もいるかもしれませんが，この 1行分にマッチする正規表現は，実は空文字列にもマッチします．そして，それは必ず $buf の最後でマッチさせる文字が何もない状態で一度だけ起こります．したがって，この無意味な空文字列を削除するために，次の行で pop(@lines); しています． $buf の中身を行ごとに分けるには split 関数を使って， split(/\x0D\x0A|\x0D|\x0A/, $buf); とすればいいのではないかと思うかもしれませんが，この方法では $buf の最後に空行があった場合にまずいことになります． split 関数の第3引数を省略すると， split した結果の最後が空文字列であった場合には自動的に削除されます．つまり，最後に空行が連続する文字列 "foo\nbar\n\n\n" のようなものを split すると ('foo', 'bar') しか残らないため，本来 ('foo', 'bar', '', '') となってほしかった最後の空行がなくなってしまいます．そこで最後の空文字列を自動的に削除させないために，第3引数に split(/\x0D\x0A|\x0D|\x0A/, $buf, -1); のように負数を指定すればいいのではないかと思うかもしれませんが，これでもまだうまくいきません．例えば， "foo\nbar\n" を split すると，今度は ('foo', 'bar', '') のように最後の改行コードの後ろの空文字列が削除されずに残ってしまいます．そこで，これに対処するために最後が空文字列であった場合には削除するように， pop(@lines) if $lines[-1] eq ''; とする手があります．しかし，これを行なうことによって，ちょうど $bufsize ずつ区切った前後が改行コードであった場合には必要な空行まで削除してしまいます．そのためさらに， read の後に $buf_tmp = "\n" if $buf_tmp eq ''; を入れる必要があります．これで正規表現を使った方法とほぼ同じ動作をするようになります．ただ，私がベンチマークをとって調べたところ，正規表現を使った方法の方が速かったためそちらを採用しました．トップへ

ファイルの最後の数行だけ表示する

# ファイル $file の最後の最大 $n行だけ表示する $bufsize = 1024; open(FILE, "< $file"); binmode(FILE); $size = (-s FILE) / $bufsize; $pos += $size <=> ($pos = int($size)); while ($pos--) { seek(FILE, $bufsize * $pos, 0); read(FILE, $buf, $bufsize); $buf .= $buf_tmp; ($buf_tmp, @lines) = $buf =~ /[^\x0D\x0A]*\x0D?\x0A?/g; pop(@lines); unshift(@tail, @lines); last if @tail >= $n; } close(FILE); unshift(@tail, $buf_tmp); @tail = @tail[-$n .. -1] if @tail > $n; foreach (@tail) { print $_; }
このスクリプトの基本は﹁ファイルの中身を逆順に表示する﹂のスクリプトと同じです．スクリプトの詳細についてはそちらを参照してください．違いとしては $n 行を取り出すことができた時点ですぐに while ブロックを抜けるようにしているところです．実際に表示する直前では @tail の大きさを調べ，もし $n よりも大きければ最後の $n 個だけを配列スライスで取り出して代入し直しています． .. は範囲演算子と言い，リストコンテキストで実行した場合は範囲演算子の前の値から後ろの値までのリストを返します．つまり，この場合は (-$n, -$n+1,..., -2, -1) というリストになります．配列の添え字が負数だった場合には後ろから数えた場所になるので，この場合は配列の最後の $n 個分ということになります．トップへ

ファイルから 1行ランダムに選択する

# ファイル $file から1行ランダムに選択する srand; open(FILE, "< $file"); rand($.) < 1 and $line = $_ while <FILE>; close(FILE); print $line;
このスクリプトではファイル全体をメモリに読み込まないので少ないメモリで実行させることができます．また，ファイルの行数があらかじめわかっている必要もありません．ファイル全体に対して while 文を回すわけですが， 1行ずつ読み込んで実行される部分が while よりも左側の部分です．この部分は 2つの式の and を取っています．論理演算子 and は左側が真の場合に限り右側が評価されます．つまり，この部分は if 文を使って次のように書いたものと同じ意味になります．

if (rand($.) <1) {
  $line = $_;
}

特殊変数 $. は最後に読み込んだファイルの行番号を返します．したがって，この条件が成立する確率は 1/$. になります．たとえば， 1行目のときは 1/1， 2行目のときは 1/2， 3行目のときは 1/3 の確率というようになります．これでなぜランダムに 1行選択できるのかという問題は数学の問題です．簡単に書きますと，全部で 3行のファイルだった場合に， 1行目が選択されるのは，1行目で条件が真となり， 2行目と3行目では条件が偽となる必要があります．したがって，確率は 1/1 * (1 - 1/2) * (1 - 1/3) = 1/3 となり，ちゃんと行数で割った確率になります．2行目が選択されるのは，条件が 2行目で真で 3行目で偽の場合です． 2行目で真になればそれ以前の条件は無関係だというのはいいですよね？その結果，確率はやはり 1/2 * (1 - 1/3) = 1/3 となり，行数で割った確率になります．トップへ

ディレクトリ(フォルダ)サイズを求める

# ディレクトリ $dir のサイズ $size を求める use File::Find; find(sub {$size += -s if -f}, $dir); print $size, "bytes\n";
このスクリプトはディレクトリ $dir 以下のすべてのファイルのファイルサイズの合計を求めています．あるディレクトリ以下のすべてのファイルまたはディレクトリに対して何か処理したい場合には標準モジュール File::Find の find 関数を使うのが簡単です．この関数は第2引数で与えたディレクトリに対して，ファイルまたはディレクトリを幅優先で探索し，見つかったファイルまたはディレクトリを $_ に 1つ代入しては第1引数で与えた関数を実行します．正確には第1引数には関数へのリファレンスを与えます．このスクリプトでは無名関数へのリファレンスを与えています．これは次のように書いても同じです．

# ディレクトリ $dir のサイズ $size を求める(わかりやすく)

use File::Find;

find(\&wanted, $dir);
print $size, "bytes\n";

sub wanted {
  $size += -s $_ if -f $_;
}

-s はファイルテスト演算子の 1つでファイルサイズを返します． -f はディレクトリやシンボリックリンクなどではなく普通のファイルのときに真となります．幅優先ではなく深さ優先で処理したい場合には finddepth 関数を使います．トップへ

タグを削除する

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $str の中のタグを削除した $result を作る # $tag_regex と $tag_regex_ は別途参照 $text_regex = q{[^<]*}; $result = ''; while ($str =~ /($text_regex)($tag_regex)?/gso) { last if $1 eq '' and $2 eq ''; $result .= $1; $tag_tmp = $2; if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) { $str =~ /(.*?)(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$)/gsi; ($text_tmp = $1) =~ s/</</g; $text_tmp =~ s/>/>/g; $result .= $text_tmp; } }
このスクリプトの基本は﹁自動で URI(URL) のリンクを張る﹂のスクリプトと同じです．詳しくはそちらを参照してください． $tag_regex および $tag_regex_ については﹁HTMLタグの正規表現﹂のスクリプトを正規表現として使います．また， $str には HTML文書全体を入れておきます．注意が必要な点としましては， XMPタグや PLAINTEXTタグを削除した場合には，それまでその中で無効だったタグが有効になってしまう可能性があることです．そのため，XMPタグや PLAINTEXTタグを削除するときには，その中の < を < に， > を > に変換しています．SCRIPTタグについても同様です．次のようにしてタグの開始 < と終了 > にだけ注目してタグを削除する方法ではうまくいかない場合があります．

# $str の中のタグを削除した $result を作る(不完全)

($result = $str) =~ s/<[^>]*>//g;

具体的には次のような不具合があります． ● のようなコメントの <!-- <FOO> を削除してしまう． ●<FOO BAR=">"> のようにダブルクォートで囲んだ中に > があると，そこをタグの終了と間違って <FOO BAR="> を削除してしまう． ●<XMP><FOO></XMP> のように XMPタグや PLAINTEXTタグ， SCRIPTタグの中の一見タグに見える <FOO> も削除してしまう．最初のスクリプトではこのような場合にもうまくいくようになっています．ただし，HTML文書として正しく書かれている場合を想定していますので，< に対応する > がないときなどは予期せぬ動作をすることになります．もし BRタグや Aタグなど特定のタグだけは削除したくない場合には， $tag_tmp = $2; の後に，次のようにして $tag_tmp を $result に加えるようにすればできます． $result .= $tag_tmp if $tag_tmp =~ /^<\/?(BR|A)(?![0-9A-Za-z])/i;
逆に FONTタグや IMGタグなど特定のタグだけ削除したい場合には， $tag_tmp = $2; の後に，次のようにして $tag_tmp を $result に加えるようにすればできます． $result .= $tag_tmp if $tag_tmp !~ /^<\/?(FONT|IMG)(?![0-9A-Za-z])/i;
モジュール HTML::TokeParser の get_text メソッド，または get_trimmed_text メソッドや， striphtml を使っても同じようなことができます．トップへ

自動で URI(URL) のリンクを張る

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては「漢字コードを EUC-JP に変換して処理する」を参照．

# $str の中の URI(URL) にリンクを張った $result を作る # $tag_regex と $tag_regex_ は別途参照 # $http_URL_regex と $ftp_URL_regex および $mail_regex は別途参照 $text_regex = q{[^<]*}; $result = ''; $skip = 0; while ($str =~ /($text_regex)($tag_regex)?/gso) { last if $1 eq '' and $2 eq ''; $text_tmp = $1; $tag_tmp = $2; if ($skip) { $result .= $text_tmp . $tag_tmp; $skip = 0 if $tag_tmp =~ /^<\/[aA](?![0-9A-Za-z])/; } else { $text_tmp =~ s{($http_URL_regex|$ftp_URL_regex|($mail_regex))} {my($org, $mail) = ($1, $2); (my $tmp = $org) =~ s/"/"/g; '<A HREF="' . ($mail ne '' ? 'mailto:' : '') . "$tmp\">$org</A>"}ego; $result .= $text_tmp . $tag_tmp; $skip = 1 if $tag_tmp =~ /^<[aA](?![0-9A-Za-z])/; if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) { $str =~ /(.*?(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$))/gsi; $result .= $1; } } }

$http_URL_regex については﹁http URL の正規表現﹂， $ftp_URL_regex については﹁ftp URL の正規表現﹂， $mail_regex については﹁メールアドレスの正規表現﹂の最後に書いてあるスクリプトを正規表現として使います．また， $tag_regex および $tag_regex_ については﹁HTMLタグの正規表現﹂のスクリプトを正規表現として使います．また， $str には HTML文書全体を入れておきます．このスクリプトは以下の項目に当てはまらない http URL と ftp URL およびメールアドレスについてリンクを張ります． ●タグ(コメント)の内部である． ●Aタグでリンクが張ってある． ●XMPタグ，PLAINTEXTタグ， SCRIPTタグの有効範囲内である．このスクリプトの説明を簡単にします． $str に対して，テキスト部分とタグ部分をそれぞれ 1つずつ探して while 文をまわします．タグ部分は特に処理する必要はないのでそのままです． $skip は Aタグでリンクを張り始めたときに1になります．このときはテキスト部分を特に処理することなくそのままにします．Aタグが閉じたときに $skip を 0 に戻します． Aタグでリンクを張っていないとき，テキスト部分に http URL か ftp URL またはメールアドレスを見つけた場合にはリンクを張ります．もし，タグ部分が XMPタグ，または， PLAINTEXTタグだった場合には，次に対応する閉じタグまで無条件にスキップします．無条件というのは，while 文にある条件でテキスト部分とタグ部分を取り出すことができなくなるため，閉じタグだけに注目するということです．なぜなら，これらのタグの有効範囲内では他のタグが無効になり，そのまま表示されるからです．逆に言えば，これらのタグの有効範囲内ではタグに見えてもタグではなく，普通のテキストと同じように扱わなくてはならないということです．ただし，この部分に http URL や ftp URL，メールアドレスがある場合でもリンクは張りません．もし張ったとしても，それはそのまま表示されてしまい意味がないからです． SCRIPTタグについても同様です． $str に対するパターンマッチが行なわれている 2ヶ所ともに修飾子 g がつけられていることに注目してください．修飾子 g をつけたパターンマッチをスカラーコンテキストで行なうと，前回どこまでパターンマッチを行なったかを保存しておいて，次回その続きから検索を始めてくれます．このスクリプトでは基本的にテキスト部分とタグ部分を 1つずつ探して while 文をまわしているのですが，XMPタグ， PLAINTEXTタグ，SCRIPTタグのときだけは別処理をする必要があります．その処理終了後 while 文に戻ったときには，その続きからパターンマッチをしてもらう必要があります．このようなときに， $str に対するどちらのパターンマッチにおいても修飾子 gがつけられていますので，どちらの場合も都合よく続きからパターンマッチを始めることができるわけです．置換によってリンクを張る処理ですが，単純に次のように行なったのでは 2つの理由からまずいことになります．

    $text_tmp =~ s/($http_URL_regex)/<A HREF="$1">$1<\/A>/go;
    $text_tmp =~ s/($ftp_URL_regex)/<A HREF="$1">$1<\/A>/go;
    $text_tmp =~ s/($mail_regex)/<A HREF="mailto:$1">$1<\/A>/go;

1つ目の理由は，タグの中ではダブルクォートで囲む都合上，マッチしたものがダブルクォートを含んでいるとまずいことになるということです．そこで，ダブルクォートで囲む部分については，マッチしたものに含まれるダブルクォートを " に変換するという処理が必要になります． 2つ目の理由ですが，置換の処理が http URL， ftp URL，メールアドレスのそれぞれについて独立して行なわれているということです．これらは互いに他の正規表現にマッチする部分を含むことができます．具体的な例で言いますと，次のようなものが挙げられます．

http://www.din.or.jp/~ohzaki/?ftp://ftp.din.or.jp/+foobar@example.com
ftp://ftp.din.or.jp/foobar@example.com
"http://www.din.or.jp/~ohzaki/?ftp://ftp.din.or.jp/"@example.com

上から順に http URL，ftp URL，メールアドレスとなっています．これらを独立して置換処理した場合，メールアドレスの一部を http URL として置換してしまったり，http URL の一部を ftp URL として置換してしまうというようなことが起こってしまいます．どちらがどちらに含まれるのかわからないので，置換処理の順番でどうこうできる問題ではありません．幸いなことに，先頭部分が他の正規表現にマッチすることはありませんので，これらの置換処理を 1つの正規表現としてまとめて，1回の置換処理で行なうことにより，うまくリンクを張ることができます．トップへ

文字の正規表現

# 半角スペース $space = '\x20'; # 全角スペース $Zspace = '(?:\xA1\xA1)'; # EUC-JP $Zspace_sjis = '(?:\x81\x40)'; # SJIS # 全角数字 [０-９] $Zdigit = '(?:\xA3[\xB0-\xB9])'; # EUC-JP $Zdigit_sjis = '(?:\x82[\x4F-\x58])'; # SJIS # 全角大文字 [Ａ-Ｚ] $Zuletter = '(?:\xA3[\xC1-\xDA])'; # EUC-JP $Zuletter_sjis = '(?:\x82[\x60-\x79])'; # SJIS # 全角小文字 [ａ-ｚ] $Zlletter = '(?:\xA3[\xE1-\xFA])'; # EUC-JP $Zlletter_sjis = '(?:\x82[\x81-\x9A])'; # SJIS # 全角アルファベット [Ａ-Ｚａ-ｚ] $Zalphabet = '(?:\xA3[\xC1-\xDA\xE1-\xFA])'; # EUC-JP $Zalphabet_sjis = '(?:\x82[\x60-\x79\x81-\x9A])'; # SJIS # 全角ひらがな [ぁ-ん] $Zhiragana = '(?:\xA4[\xA1-\xF3])'; # EUC-JP $Zhiragana_sjis = '(?:\x82[\x9F-\xF1])'; # SJIS # 全角ひらがな(拡張) [ぁ-ん゛゜ゝゞ] $ZhiraganaExt = '(?:\xA4[\xA1-\xF3]|\xA1[\xAB\xAC\xB5\xB6])'; # EUC-JP $ZhiraganaExt_sjis = '(?:\x82[\x9F-\xF1]|\x81[\x4A\x4B\x54\x55])'; # SJIS # 全角カタカナ [ァ-ヶ] $Zkatakana = '(?:\xA5[\xA1-\xF6])'; # EUC-JP $Zkatakana_sjis = '(?:\x83[\x40-\x96])'; # SJIS # 全角カタカナ(拡張) [ァ-ヶ・ーヽヾ] $ZkatakanaExt = '(?:\xA5[\xA1-\xF6]|\xA1[\xA6\xBC\xB3\xB4])'; # EUC-JP $ZkatakanaExt_sjis = '(?:\x83[\x40-\x96]|\x81[\x45\x5B\x52\x53])'; # SJIS # 半角カタカナ [ヲ-゜] $Hkatakana = '(?:\x8E[\xA6-\xDF])'; # EUC-JP $Hkatakana_sjis = '[\xA6-\xDF]'; # SJIS # EUC-JP文字 $ascii = '[\x00-\x7F]'; # 1バイト EUC-JP文字 $twoBytes = '(?:[\x8E\xA1-\xFE][\xA1-\xFE])'; # 2バイト EUC-JP文字 $threeBytes = '(?:\x8F[\xA1-\xFE][\xA1-\xFE])'; # 3バイト EUC-JP文字 $character = "(?:$ascii|$twoBytes|$threeBytes)"; # EUC-JP文字 # EUC-JP文字(機種依存文字・未定義領域・3バイト文字を含まない) $character_strict = '(?:[\x00-\x7F]|' # ASCII . '\x8E[\xA1-\xDF]|' # 半角カタカナ . '[\xA1\xB0-\xCE\xD0-\xF3][\xA1-\xFE]|' # 1,16-46,48-83区 . '\xA2[\xA1-\xAE\xBA-\xC1\xCA-\xD0\xDC-\xEA\xF2-\xF9\xFE]|' # 2区 . '\xA3[\xB0-\xB9\xC1-\xDA\xE1-\xFA]|' # 3区 . '\xA4[\xA1-\xF3]|' # 4区 . '\xA5[\xA1-\xF6]|' # 5区 . '\xA6[\xA1-\xB8\xC1-\xD8]|' # 6区 . '\xA7[\xA1-\xC1\xD1-\xF1]|' # 7区 . '\xA8[\xA1-\xC0]|' # 8区 . '\xCF[\xA1-\xD3]|' # 47区 . '\xF4[\xA1-\xA6])'; # 84区 # EUC-JP未定義文字(機種依存文字・3バイト文字を含む) $character_undef = '(?:[\xA9-\xAF\xF5-\xFE][\xA1-\xFE]|' # 9-15,85-94区 . '\x8E[\xE0-\xFE]|' # 半角カタカナ . '\xA2[\xAF-\xB9\xC2-\xC9\xD1-\xDB\xEB-\xF1\xFA-\xFD]|' # 2区 . '\xA3[\XA1-\xAF\xBA-\xC0\xDB-\xE0\xFB-\xFE]|' # 3区 . '\xA4[\xF4-\xFE]|' # 4区 . '\xA5[\xF7-\xFE]|' # 5区 . '\xA6[\xB9-\xC0\xD9-\xFE]|' # 6区 . '\xA7[\xC2-\xD0\xF2-\xFE]|' # 7区 . '\xA8[\xC1-\xFE]|' # 8区 . '\xCF[\xD4-\xFE]|' # 47区 . '\xF4[\xA7-\xFE]|' # 84区 . '\x8F[\xA1-\xFE][\xA1-\xFE])'; # 3バイト文字 # SJIS文字 $oneByte_sjis = '[\x00-\x7F\xA1-\xDF]'; # 1バイト SJIS文字 $twoBytes_sjis = '(?:[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC])'; # 2バイト SJIS文字 $character_sjis = "(?:$oneByte_sjis|$twoBytes_sjis)"; # SJIS文字 # SJIS文字(機種依存文字・未定義領域を含まない) $character_sjis_strict = '(?:[\x00-\x7F\xA1-\xDF]|' # ASCII，半角カタカナ . '[\x89-\x97\x99-\x9F\xE0-\xE9][\x40-\x7E\x80-\xFC]|' # 17-46,49-82区 . '\x81[\x40-\x7E\x80-\xAC\xB8-\xBF\xC8-\xCE\xDA-\xE8\xF0-\xF7\xFC]|' # 1,2区 . '\x82[\x4F-\x58\x60-\x79\x81-\x9A\x9F-\xF1]|' # 3,4区 . '\x83[\x40-\x7E\x80-\x96\x9F-\xB6\xBF-\xD6]|' # 5,6区 . '\x84[\x40-\x60\x70-\x7E\x80-\x91\x9F-\xBE]|' # 7,8区 . '\x88[\x9F-\xFC]|' # 15,16区 . '\x98[\x40-\x72\x9F-\xFC]|' # 47,48区 . '\xEA[\x40-\x7E\x80-\xA4])'; # 83,84区 # SJIS未定義文字(機種依存文字を含む) $character_sjis_undef = '(?:[\x85-\x87\xEB-\xFC][\x40-\x7E\x80-\xFC]|' # 9-14,85-120区 . '\x81[\xAD-\xB7\xC0-\xC7\xCF-\xD9\xE9-\xEF\xF8-\xFB]|' # 1,2区 . '\x82[\x40-\x4E\x59-\x5F\x7A-\x7E\x80\x9B-\x9E\xF2-\xFC]|' # 3,4区 . '\x83[\x97-\x9E\xB7-\xBE\xD7-\xFC]|' # 5,6区 . '\x84[\x61-\x6F\x92-\x9E\xBF-\xFC]|' # 7,8区 . '\x88[\x40-\x7E\x80-\x9E]|' # 15,16区 . '\x98[\x73-\x7E\x80-\x9E]|' # 47,48区 . '\xEA[\xA5-\xFC])'; # 83,84区 # ドコモ絵文字 $iPictograph_base = '(?:\xF8[\x9F-\xFC]|' # 基本絵文字(SJIS) . '\xF9[\x40-\x49\x50-\x52\x55-\x57\x5B-\x5E\x72-\x7E\x80-\xB0])'; $iPictograph_ext = '(?:\xF9[\xB1-\xFC])'; # 拡張絵文字(SJIS) $iPictograph = '(?:$iPictograph_base|$iPictograph_ext)'; # iモード対応絵文字(SJIS)
日本語の扱いについては﹁日本語を扱う﹂を参照．個々の機種依存文字についてはここでは扱わないこととする．なぜなら，機種依存文字は各ベンダ・文字コードごとに非常に多くの種類が存在し，そのすべてを把握することは不可能なためである．以下のリンク先の文書の外字(ユーザ定義とベンダ定義)の欄が機種依存文字に該当する． ● ベンダ別 EUC コード一覧 ● ベンダ別 SJIS コード一覧トップへ

HTMLタグの正規表現

# HTMLタグの正規表現 $tag_regex $tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}} $comment_tag_regex = '<!(?:--[^-]*-(?:[^-]+-)*?-(?:[^>-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)'; $tag_regex = qq{$comment_tag_regex|<$tag_regex_};
このスクリプトの $comment_tag_regex がコメントタグの正規表現で， $tag_regex_ がコメントタグ以外の普通のタグの < 以降の正規表現になります．最初に普通のタグの正規表現について説明します．普通のタグの中身の正規表現として最初に思いつくのは [^>]* です．しかし，これではダブルクォートやシングルクォートで囲まれた中に > があった場合にまずいことになります．そこで，ダブルクォートやシングルクォートについて考えます．ダブルクォートで囲まれている部分の正規表現は "[^"]*" と書くことができます．シングルクォートで囲まれている部分についても同様です．これでダブルクォートやシングルクォートで囲まれている内側には > を含むことができます．それ以外のダブルクォートでもシングルクォートでも囲まれていない部分は今度こそ [^>] だから，結局 (?:[^>]|"[^"]*"|'[^']')* でいいか，というとそううまくはいきません． [^>] ではダブルクォートやシングルクォートまで含んでしまうため，せっかく用意したダブルクォートやシングルクォートで囲まれている部分の正規表現が使われることなくそのままマッチングが進んで，ダブルクォートやシングルクォートの中の > をタグの終わりと間違えてマッチが成功してしまいます．これを回避するには， (?:"[^"]*"|'[^']*'|[^>])* のように最初にダブルクォートかシングルクォートで囲まれているかどうかを調べる方法があります．しかし，これは明らかに遅いです．なぜかというと，ダブルクォートやシングルクォートで囲まれていない部分の場合， 1文字ごとにダブルクォートとシングルクォートのマッチングが失敗してからでないと [^>] にマッチしないためです．そこで次のように [^"'>] とするとすべてがうまくいきます．

$tag_regex_ = q{(?:[^"'>]|"[^"]*"|'[^']*')*}; #'}}}

次に閉じないタグのことを考えます．閉じないタグとは <P のように > を省略してあるものです．このとき <P を正しくタグとして認識するためには，タグの中身は [^>]* ではなく [^<>]* としなければならないことになります．また，タグの最後は必ず > で終わるとは限らないので， (?:>|(?=<)|$(?!\n)) とする必要があります．これは > で終わる普通のタグか，または，その次の文字がタグの開始文字である < であるか，または，文字列の最後である場合を表しています．$(?!\n) については後で詳しく説明します．結局，これをまとめると次のようになります．

$tag_regex_ = q{(?:[^"'<>]|"[^"]*"|'[^']*')*(?:>|(?=<)|$(?!\n))}; #'}}}

これを Jeffrey E. F. Friedl氏原著による﹁詳説正規表現﹂で﹁ループ展開﹂として書かれている手法で実行速度を速くしたものが最初のスクリプトの正規表現です．簡単なベンチマークをとってみたところ約 1.5倍ほど速かったです．次にコメントタグの正規表現の説明をします．コメントタグについては，まずは水無月ばけらさんによる﹁ SGMLの注釈宣言﹂を一読することをお勧めします．コメントタグ，すなわち，注釈宣言は --コメントの中身-- というコメントだけから構成されています．コメントタグは複数のコメントを持つことができ，コメントの後ろには空白文字のみあってもかまいません．また，コメントの中身やコメントの数が 0個であってもかまいません．ただし，<! とコメントの間に空白文字があることは許されていないので，<! の直後にはコメントか閉じ括弧の > しか来てはいけないことになります．以上のことから，正常なコメントタグの正規表現は次のようになります． # 正常なコメントタグの正規表現 $comment_tag_regex $comment_tag_regex = q{<!(?:--(?:(?!--).)*--\s*)*>};
この正常なコメントタグの正規表現をもとに，閉じないコメントタグだった場合と，コメントの後ろに空白文字以外の文字があって不正であるコメントタグだった場合にも対応した正規表現が最初のスクリプトになります．最後の (?:>|$(?!\n)|--.*$) の選択はそれぞれ，コメントタグが閉じていた場合，コメントの後に > がなく閉じていなかった場合，コメントの終わりの -- がなくコメントの中身が最後まで続いている場合を表わしています． $(?!\n) ですが，ただの $ でもよいのではないかと疑問に思われる人もいるかと思いますが，$(?!\n) と $ では少し意味が違います．たとえば， $str = "test\n"; のとき， m/^test$/ はマッチしますが，m/^test$(?!\n)/ はマッチしません．なぜなら，$ は文字列の最後に改行があった場合には，改行の直前でもマッチするからです．もし， 'test' にはマッチしてほしいが， "test\n" にはマッチしてほしくないというときに，ただの $ では困るわけです．コメントタグの正規表現では "<!\n" のような場合にマッチしてもらっては困るのでこのような正規表現になっています． perl5.005 以降ならば $(?!\n) を \z とすることができます． \z は $ や \Z と違って本当の意味で文字列の最後にマッチします．実は次のようにコメントタグの正規表現を書いても同じことができます．理解するにはまずこちらの正規表現をもとに考えた方がよいかもしれません．

# コメントタグの正規表現(遅い)

$comment_tag_regex = '<!(?:--(?:(?!--).)*--(?:(?!--)[^>])*)*(?:>|$(?!\n)|--.*$)';

この正規表現では，コメントの中身を表わす正規表現として (?:(?!--).)* としています．これの意味は，次に -- が来ないような何か 1文字の繰り返しということです．つまり， - が単独で現れた場合には問題ないわけで， -- と続けて現れる - は駄目だということになります．これでコメントの中身には -- が絶対に現れないことが保証されます．コメントの中身を表わす正規表現としてはこれで正しいのですが， 1文字ごとに -- でないことをチェックしているのでこのままでは実行速度が遅いです．そこで普通のタグのときと同様に﹁ループ展開﹂の手法を用いることとします．まず，-- が来ない何か 1文字の繰り返しを表わす (?:(?!--).)* を少し違う考え方で表現し直します．この正規表現は -- が含まれない部分ということですので，まず，-以外の文字ならば問題ないことはすぐにわかると思います．仮に - が来たとしてもその次の文字が -以外の文字であればその場合もまた大丈夫です．ということは，(?:(?!--).)* は (?:[^-]|-[^-])* と変形することができます．これに対して﹁ループ展開﹂の手法を用いると， [^-]*(?:-[^-][^-]*)* となり，結局 [^-]*(?:-[^-]+)* となります．これでコメント部分の正規表現は --[^-]*(?:-[^-]+)*-- となりました．簡単なベンチマークをとったところ約 2倍ほど速くなりました．しかし，まだ最初のスクリプトとは少し違っています．このコメント部分の正規表現には非決定性なところがあります．それは - が来たときに，その時点ではそれがコメントの中身なのか，コメントの終了を表わす -- の最初の 1文字なのかわかりませんが，正規表現でもやはりマッチする可能性がある場所が 2ヶ所になっているということです．つまり，(?:-[^-]+)* の (?: 直後の - にマッチするかもしれないし， (?:-[^-]+)* 直後の - にマッチするかもしれないのです．このような非決定性はバックトラック発生時に多くの負担を強いることになります．そこで， [^-]*(?:-[^-]+)*-- を変形し，非決定性を排除すると [^-]*-(?:[^-]+-)*- となります．これで - が来たときにマッチする正規表現の部分は [^-]* 直後の - の 1ヶ所となります．ここまでの変形でかなり最初のスクリプトに近づきましたが，まだ 1ヶ所違っています．それは (?:[^-]+-)* と (?:[^-]+-)*?，つまり， * と *? の違いです．一般に * と *? を変えたらマッチするものも変わってしまいます．しかし，今回の場合は * でも *? でも必ず同じ結果となります．必ず同じ結果となることがわかっているので，実行速度が速い方を考えます．一般にコメントタグというものは <-- これはコメントタグです --> というようなものがほとんどでしょう．つまり，コメントタグの中身として - を含んでいるものの出現頻度は，含んでいないものの出現頻度よりも低いということです．もし，コメントタグの中身に - を含んでいた場合は (?:[^-]+-) の部分を通過することになります．しかし，実際には含んでいないことの方が多いわけですから， (?:[^-]+-) の部分をチェックするのは無駄なことになります．そこで，* を *? とすることでこの無駄を可能な限り排除することができます．次に (?:(?!--)[^>])* の部分について考えます．ここもコメントタグの中身の部分と同様にまずは﹁ループ展開﹂の手法を用いて (?:[^>-]*(?:-[^>-]+)* と変形します．更に， * を *? とすることができますので， (?:[^>-]*(?:-[^>-]+)*? と変形するところまでは同じです．最初のスクリプトでは更に全体を (?: regex)?? というように ??をつけた形にしています．これは，コメントタグの中身と違って，一般にコメントの終了を表わす -- の後ろには何か文字が入ることなく直後に > で閉じられているものの出現頻度が高いと思われるためです．言い換えると， (?:[^>-]*(?:-[^>-]+)*? がマッチすることはほとんどない，つまり，マッチさせようとすると無駄に終わることが多いと思われるため，この部分の正規表現全体に ?? をつけて，可能な限りチェックさせないようにしています．トップへ

URI(URL) の正規表現

# $uri が正しい URI か判定する $digit = q{[0-9]}; $upalpha = q{[A-Z]}; $lowalpha = q{[a-z]}; $alpha = qq{(?:$lowalpha|$upalpha)}; $alphanum = qq{(?:$alpha|$digit)}; $hex = qq{(?:$digit|[A-Fa-f])}; $escaped = qq{%$hex$hex}; $mark = q{[-_.!~*'()]}; $unreserved = qq{(?:$alphanum|$mark)}; $reserved = q{[;/?:@&=+$,]}; $uric = qq{(?:$reserved|$unreserved|$escaped)}; $fragment = qq{$uric*}; $query = qq{$uric*}; $pchar = qq{(?:$unreserved|$escaped|} . q{[:@&=+$,])}; $param = qq{$pchar*}; $segment = qq{$pchar*(?:;$param)*}; $path_segments = qq{$segment(?:/$segment)*}; $abs_path = qq{/$path_segments}; $uric_no_slash = qq{(?:$unreserved|$escaped|} . q{[;?:@&=+$,])}; $opaque_part = qq{$uric_no_slash$uric*}; $path = qq{(?:$abs_path|$opaque_part)?}; $port = qq{$digit*}; $IPv4address = qq{$digit+\\.$digit+\\.$digit+\\.$digit+}; $toplabel = qq{(?:$alpha|$alpha(?:$alphanum|-)*$alphanum)}; $domainlabel = qq{(?:$alphanum|$alphanum(?:$alphanum|-)*$alphanum)}; $hostname = qq{(?:$domainlabel\\.)*$toplabel\\.?}; $host = qq{(?:$hostname|$IPv4address)}; $hostport = qq{$host(?::$port)?}; $userinfo = qq{(?:$unreserved|$escaped|} . q{[;:&=+$,])*}; $server = qq{(?:(?:$userinfo\@)?$hostport)?}; $reg_name = qq{(?:$unreserved|$escaped|} . q{[$,;:@&=+])+}; $authority = qq{(?:$server|$reg_name)}; $scheme = qq{$alpha(?:$alpha|$digit|[-+.])*}; $rel_segment = qq{(?:$unreserved|$escaped|} . q{[;@&=+$,])+}; $rel_path = qq{$rel_segment(?:$abs_path)?}; $net_path = qq{//$authority(?:$abs_path)?}; $hier_part = qq{(?:$net_path|$abs_path)(?:\\?$query)?}; $relativeURI = qq{(?:$net_path|$abs_path|$rel_path)(?:\\?$query)?}; $absoluteURI = qq{$scheme:(?:$hier_part|$opaque_part)}; $URI_reference = qq{(?:$absoluteURI|$relativeURI)?(?:#$fragment)?}; $pattern = $URI_reference; print "ok\n" if $uri =~ /^$pattern$/o;
URI については RFC 2396( 日本語訳 )に書かれています．それを機械的に素直に正規表現にしたものが上のスクリプトです．これから求めた URI References の正規表現は次のようになりました．

(?:(?:[a-z]|[A-Z])(?:(?:[a-z]|[A-Z])|[0-9]|[-+.])*:(?:(?://(?:(?:(
?:(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])
(?:[0-9]|[A-Fa-f])|[;:&=+$,])*@)?(?:(?:(?:(?:(?:[a-z]|[A-Z])|[0-9]
)|(?:(?:[a-z]|[A-Z])|[0-9])(?:(?:(?:[a-z]|[A-Z])|[0-9])|-)*(?:(?:[
a-z]|[A-Z])|[0-9]))\.)*(?:(?:[a-z]|[A-Z])|(?:[a-z]|[A-Z])(?:(?:(?:
[a-z]|[A-Z])|[0-9])|-)*(?:(?:[a-z]|[A-Z])|[0-9]))\.?|[0-9]+\.[0-9]
+\.[0-9]+\.[0-9]+)(?::[0-9]*)?)?|(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[
-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[$,;:@&=+])+)(?:
/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(
?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[
-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*(?:
/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(
?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[
-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*)*)
?|/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f]
)(?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])
|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*(
?:/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f]
)(?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])
|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*)
*)(?:\?(?:[;/?:@&=+$,]|(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%
(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f]))*)?|(?:(?:(?:(?:[a-z]|[A-Z])|
[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[;?:@&=+
$,])(?:[;/?:@&=+$,]|(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:
[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f]))*)|(?://(?:(?:(?:(?:(?:(?:(?:[a-
z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f]
)|[;:&=+$,])*@)?(?:(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|(?:(?:[a-z]|[A-
Z])|[0-9])(?:(?:(?:[a-z]|[A-Z])|[0-9])|-)*(?:(?:[a-z]|[A-Z])|[0-9]
))\.)*(?:(?:[a-z]|[A-Z])|(?:[a-z]|[A-Z])(?:(?:(?:[a-z]|[A-Z])|[0-9
])|-)*(?:(?:[a-z]|[A-Z])|[0-9]))\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+
)(?::[0-9]*)?)?|(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[
0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[$,;:@&=+])+)(?:/(?:(?:(?:(?:[a-z
]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])
|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[
0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*(?:/(?:(?:(?:(?:[a-z
]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])
|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[
0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*)*)?|/(?:(?:(?:(?:[a
-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f
])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?
:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*(?:/(?:(?:(?:(?:[a
-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f
])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?
:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*)*)*|(?:(?:(?:(?:[a-
z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f]
)|[;@&=+$,])+(?:/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:
[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]
|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|
[:@&=+$,])*)*(?:/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:
[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]
|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|
[:@&=+$,])*)*)*)?)(?:\?(?:[;/?:@&=+$,]|(?:(?:(?:[a-z]|[A-Z])|[0-9]
)|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f]))*)?)?(?:#(?:[
;/?:@&=+$,]|(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A
-Fa-f])(?:[0-9]|[A-Fa-f]))*)?

この正規表現はあまりにも一般的すぎて，ほとんどの入力に対してマッチしてしまいます．RFC 2396 はもともと URI の一般形を定義したものであるので，この正規表現を使うことはほとんどないと言っていいでしょう．トップへ

http URL の正規表現

# $http が正しい http URL か判定する $digit = q{[0-9]}; $upalpha = q{[A-Z]}; $lowalpha = q{[a-z]}; $alpha = qq{(?:$lowalpha|$upalpha)}; $alphanum = qq{(?:$alpha|$digit)}; $hex = qq{(?:$digit|[A-Fa-f])}; $escaped = qq{%$hex$hex}; $mark = q{[-_.!~*'()]}; $unreserved = qq{(?:$alphanum|$mark)}; $reserved = q{[;/?:@&=+$,]}; $uric = qq{(?:$reserved|$unreserved|$escaped)}; $query = qq{$uric*}; $pchar = qq{(?:$unreserved|$escaped|} . q{[:@&=+$,])}; $param = qq{$pchar*}; $segment = qq{$pchar*(?:;$param)*}; $path_segments = qq{$segment(?:/$segment)*}; $abs_path = qq{/$path_segments}; $port = qq{$digit*}; $IPv4address = qq{$digit+\\.$digit+\\.$digit+\\.$digit+}; $toplabel = qq{(?:$alpha|$alpha(?:$alphanum|-)*$alphanum)}; $domainlabel = qq{(?:$alphanum|$alphanum(?:$alphanum|-)*$alphanum)}; $hostname = qq{(?:$domainlabel\\.)*$toplabel\\.?}; $host = qq{(?:$hostname|$IPv4address)}; $http_URL = qq{http://$host(?::$port)?(?:$abs_path(?:\\?$query)?)?}; $pattern = $http_URL; print "ok\n" if $http =~ /^$pattern$/;
http URL については RFC 2616 の 3.2.2 http URL に書かれています．このスクリプトは，﹁URI(URL) の正規表現﹂で書いた URI(URL) の正規表現のスクリプトを修正し， http URL の正規表現にしたものです．このスクリプトから求めた http URL の正規表現は次のようになりました．

http://(?:(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|(?:(?:[a-z]|[A-Z])|[0-9]
)(?:(?:(?:[a-z]|[A-Z])|[0-9])|-)*(?:(?:[a-z]|[A-Z])|[0-9]))\.)*(?:
(?:[a-z]|[A-Z])|(?:[a-z]|[A-Z])(?:(?:(?:[a-z]|[A-Z])|[0-9])|-)*(?:
(?:[a-z]|[A-Z])|[0-9]))\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9
]*)?(?:/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-
Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[
0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,]
)*)*(?:/(?:(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()])|%(?:[0-9]|[A-
Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,])*(?:;(?:(?:(?:(?:[a-z]|[A-Z])|[
0-9])|[-_.!~*'()])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f])|[:@&=+$,]
)*)*)*(?:\?(?:[;/?:@&=+$,]|(?:(?:(?:[a-z]|[A-Z])|[0-9])|[-_.!~*'()
])|%(?:[0-9]|[A-Fa-f])(?:[0-9]|[A-Fa-f]))*)?)?

この http URL の正規表現は，文字クラス同士の選択がまとめられていないので無駄が多いことがわかります．そこで，文字クラスをなるべくまとめるように以下のように一部改良します． # $http が正しい http URL か判定する(文字クラス改良版) $alpha = q{[a-zA-Z]}; $alphanum = q{[a-zA-Z0-9]}; $hex = q{[0-9A-Fa-f]}; $uric = q{(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]} . qq{|$escaped)}; $pchar = q{(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]} . qq{|$escaped)}; $toplabel = qq{(?:$alpha|$alpha} . q{[-a-zA-Z0-9]*} . qq{$alphanum)}; $domainlabel = qq{(?:$alphanum|$alphanum} . q{[-a-zA-Z0-9]*} . qq{$alphanum)};
このスクリプトから求めた http URL の正規表現は次のようになりました．

http://(?:(?:(?:[a-zA-Z0-9]|[a-zA-Z0-9][-a-zA-Z0-9]*[a-zA-Z0-9])\.
)*(?:[a-zA-Z]|[a-zA-Z][-a-zA-Z0-9]*[a-zA-Z0-9])\.?|[0-9]+\.[0-9]+\
.[0-9]+\.[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0
-9A-Fa-f][0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa
-f][0-9A-Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][
0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-F
a-f])*)*)*(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A
-Fa-f])*)?)?

この正規表現は前述しましたが，RFC 2616 の 3.2.2 http URL に書かれています．RFC 2616 には HTTPプロトコルに関することが書かれており，3.2.2 http URL に書かれている http URL も，HTTPプロトコルの中での話になります．一般に，HTML のリンクに使用されるものは，純粋に HTTPプロトコルの中で使用される http URL ではなく， scheme が http であるURI References です．たとえば http://user:passwd@www.din.or.jp/~ohzaki/perl.htm#URI は URI References ですが，user:passwd@ の部分，すなわち，userinfo や，#URI の部分，すなわち， Fragment Identifier は HTTPプロトコルの中で使用される http URL としては不正なものとなります．しかし，HTML のリンクとしては問題ありません．なぜなら，クライアント(ブラウザ)が HTTPプロトコルで通信する際にはそれらを削除しているからです．余談ですが， RFC 2396( 日本語訳 ) の第4章には Fragment Identifier は URI の一部ではないと書かれています．Fragment Identifier は user agent によって解釈される付加的参照情報だそうです．次に，scheme が http である URI References を考えます．そこで再び﹁URI(URL) の正規表現﹂で書いた URI(URL) の正規表現のスクリプトを修正して作ります．その際， HTTPプロトコルの中で使用される http URL を構築するのに必要な情報を必ず含んでいれば，それ以外に冗長な情報を含んでいてもよいとします．必要な情報とは，host，port， abs_path，query です．また，scheme は当然 http ですが，この際， Secure Hyper Text Tranasfer Protocol(S-HTTP)と呼ばれるプロトコルを使う shttp: や Secure Sockets Layer(SSL) というプロトコルを使う https: にも対応するようにしておきます．修正した結果は，以下のように一部を修正することになりました． $server = qq{(?:$userinfo\@)?$hostport}; $authority = qq{$server}; $scheme = q{(?:https?|shttp)}; $hier_part = qq{$net_path(?:\\?$query)?}; $absoluteURI = qq{$scheme:$hier_part}; $URI_reference = qq{$absoluteURI(?:#$fragment)?};
これに先ほどと同じように文字クラスをまとめる改良として，以下のように一部を修正しました． $alpha = q{[a-zA-Z]}; $alphanum = q{[a-zA-Z0-9]}; $hex = q{[0-9A-Fa-f]}; $unreserved = q{[-_.!~*'()a-zA-Z0-9]}; $uric = q{(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]} . qq{|$escaped)}; $pchar = q{(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]} . qq{|$escaped)}; $toplabel = qq{(?:$alpha|$alpha} . q{[-a-zA-Z0-9]*} . qq{$alphanum)}; $domainlabel = qq{(?:$alphanum|$alphanum} . q{[-a-zA-Z0-9]*} . qq{$alphanum)}; $userinfo = q{(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|} . qq{$escaped)*};
このようにして求めた正規表現は次のようになりました．

(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f][
0-9A-Fa-f])*@)?(?:(?:(?:[a-zA-Z0-9]|[a-zA-Z0-9][-a-zA-Z0-9]*[a-zA-
Z0-9])\.)*(?:[a-zA-Z]|[a-zA-Z][-a-zA-Z0-9]*[a-zA-Z0-9])\.?|[0-9]+\
.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=
+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%
[0-9A-Fa-f][0-9A-Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9
A-Fa-f][0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f
][0-9A-Fa-f])*)*)*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-
Fa-f][0-9A-Fa-f])*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-F
a-f][0-9A-Fa-f])*)?

この正規表現を使えば， $http が， scheme が http である URI References かどうか判定することはできます．ところが，ある文字列の中から http URL を抽出する目的でこの正規表現を使ってもうまくいきません．たとえば，次のようなスクリプトを実行するとうまくいかないことがわかります．

# $str から http URI References を抽出する

$str = "このページの URI は http://www.din.or.jp/~ohzaki/perl.htm です";

$pattern = $URI_reference;

while ($str =~ /($pattern)/g) {
  print $1, "\n";
}

実行結果(失敗例)
http://www.din.or.j

なぜこのような結果になってしまったのでしょうか．それは Perl のパターンマッチエンジンが非決定性有限オートマトン NFAs(Nondeterministic Finite Automata) だからです．次のようなスクリプトを考えてみてください．

print "数字1文字or数字で始まり数字か小文字が続くもの\n";
$str = '123abc';
@patterns = ('(?:\d|\d[0-9a-z]+)', '(?:\d[0-9a-z]*)');
foreach $pattern (@patterns) {
  print "  文字列 $str  パターン $pattern  ";
  print '結果 ' . join('/', $str =~ /$pattern/g) . "\n";
}
print "\n数字1文字or最初が数字か小文字で，次が小文字のもの\n";
$str = '1a';
@patterns = ('(?:\d|[\da-z][a-z])', '(?:[\da-z][a-z]|\d)');
foreach $pattern (@patterns) {
  print "  文字列 $str  パターン $pattern  ";
  print '結果 ' . join('/', $str =~ /$pattern/g) . "\n";
}

実行結果
数字1文字or最初が数字で，その後数字か小文字が続くもの
  文字列 123abc  パターン (?:\d|\d[0-9a-z]+)  結果 1/2/3
  文字列 123abc  パターン (?:\d[0-9a-z]*)  結果 123abc

数字1文字or最初が数字か小文字で，次が小文字のもの
  文字列 1a  パターン (?:\d|[\da-z][a-z])  結果1文字列 1a  パターン (?:[\da-z][a-z]|\d)  結果 1a

2つの例のうち，どちらも最初の正規表現では文字列の一部にしかマッチしていないことがわかると思います．このように Perl のパターンマッチエンジンはうまくマッチさせていけばもっと長い文字列にマッチさせることができる場合でも，最初に見つかった方法でパターンマッチを進めてしまいます．それではなぜもう一方の正規表現ではうまく文字列全体にマッチさせることができたのでしょうか． 1つめの例では， (?:regex1|regex1regex2+) という選択を regex1regex2* という形に変形し，選択が現れないようにしています．このようにすることで，より長くマッチさせることができ，また，ほとんどの場合にバックトラックを減らすことができるので効率的になります．これと同じこと行ない，以下のように一部改良します． $toplabel = qq{$alpha(?:} . q{[-a-zA-Z0-9]*} . qq{$alphanum)?}; $domainlabel = qq{$alphanum(?:} . q{[-a-zA-Z0-9]*} . qq{$alphanum)?};
2つめの例では， (?:regex1|regex2) という選択で，regex1 が regex2 の一部とマッチしてしまう場合に，より長くマッチできる可能性である．regex2 を試すことなく regex1 が選択されてしまったために文字列の一部にマッチしてしまったのです．選択を逆にした， (?:regex2|regex1) の形に修正することで，このような事態を避けることができます．実際にその可能性のある選択を持つ部分というと，host の正規表現の hostname と IPv4address の選択の部分になります．なぜなら，IPv4address の正規表現は hostname の一部とマッチしてしまう可能性があるからです．例えば， 127.0.0.1.www.din.or.jp という host があった場合，先に IPv4address をマッチさせてしまうと 127.0.0.1 の部分にマッチしてしまいます．幸い，最初から host の正規表現は先に hostname をマッチさせるようになっていますので，特に修正する必要はないことになります．最後に，pseudohttp://foo/bar.htm のように HTTP ではない scheme の途中からマッチしてしまうことがないように，以下のように改良します． $http_URL_regex = q{\b} . $URI_reference;
以上の改良をすべてまとめた最終的なスクリプトは以下のようになりました． # http URL の正規表現 $http_URL_regex $digit = q{[0-9]}; $alpha = q{[a-zA-Z]}; $alphanum = q{[a-zA-Z0-9]}; $hex = q{[0-9A-Fa-f]}; $escaped = qq{%$hex$hex}; $uric = q{(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]} . qq{|$escaped)}; $fragment = qq{$uric*}; $query = qq{$uric*}; $pchar = q{(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]} . qq{|$escaped)}; $param = qq{$pchar*}; $segment = qq{$pchar*(?:;$param)*}; $path_segments = qq{$segment(?:/$segment)*}; $abs_path = qq{/$path_segments}; $port = qq{$digit*}; $IPv4address = qq{$digit+\\.$digit+\\.$digit+\\.$digit+}; $toplabel = qq{$alpha(?:} . q{[-a-zA-Z0-9]*} . qq{$alphanum)?}; $domainlabel = qq{$alphanum(?:} . q{[-a-zA-Z0-9]*} . qq{$alphanum)?}; $hostname = qq{(?:$domainlabel\\.)*$toplabel\\.?}; $host = qq{(?:$hostname|$IPv4address)}; $hostport = qq{$host(?::$port)?}; $userinfo = q{(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|} . qq{$escaped)*}; $server = qq{(?:$userinfo\@)?$hostport}; $authority = qq{$server}; $scheme = q{(?:https?|shttp)}; $net_path = qq{//$authority(?:$abs_path)?}; $hier_part = qq{$net_path(?:\\?$query)?}; $absoluteURI = qq{$scheme:$hier_part}; $URI_reference = qq{$absoluteURI(?:#$fragment)?}; $http_URL_regex = q{\b} . $URI_reference;

このスクリプトから求めた http URL の正規表現は次のようになりました．

\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f ][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.) *[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\. [0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f] [0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A- Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f ])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*) *)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f]) *)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])* )?

この正規表現を使えば，http URL の抽出がうまくいくようになります．以下がこれを直接代入して使うスクリプトになります．

$http_URL_regex = q{\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f} . q{][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)} . q{*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.} . q{[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f]} . q{[0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-} . q{Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f} . q{])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)} . q{*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])} . q{*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} . q{)?};

さて，ここまで長々と書いてきましたが，正確に正規表現を書くことをあきらめて，もっと簡単でいいやという人のための http URL の正規表現が以下になります．

s?https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+

この正規表現を一旦変数に代入して使用する場合は問題ありませんが，直接正規表現として利用する場合は次のように書く必要があります．

# 文書 $text から http URL を抽出して @http に格納する

@http = $text =~ /s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+/g;

/ が \/ になっているのは問題ないと思います．特に注意しなければいけないのは，$ と @ の部分です．これらはそのままではそれぞれスカラー変数・配列変数として扱われ，変数展開の対象となってしまいます．そこでこの 2つについても \$ と \@ のようにする必要があります．もし，この 2つに \ をつけ忘れていた場合はどうなるのか？そのときは，$ については特殊変数 $, として通常は空文字列に展開されてしまいます． @ については @& で始まるような配列変数は存在しないので，配列変数としては扱われずそのままになります．トップへ

ftp URL の正規表現

# ftp URL の正規表現 $ftp_URL_regex $digit = q{[0-9]}; $alpha = q{[a-zA-Z]}; $alphanum = q{[a-zA-Z0-9]}; $hex = q{[0-9A-Fa-f]}; $escaped = qq{%$hex$hex}; $uric = q{(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]} . qq{|$escaped)}; $fragment = qq{$uric*}; $query = qq{$uric*}; $pchar = q{(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]} . qq{|$escaped)}; $segment = qq{$pchar*}; $ftptype = q{[AIDaid]}; $path_segments = qq{$segment(?:/$segment)*(?:;type=$ftptype)?}; $abs_path = qq{/$path_segments}; $port = qq{$digit*}; $IPv4address = qq{$digit+\\.$digit+\\.$digit+\\.$digit+}; $toplabel = qq{$alpha(?:} . q{[-a-zA-Z0-9]*} . qq{$alphanum)?}; $domainlabel = qq{$alphanum(?:} . q{[-a-zA-Z0-9]*} . qq{$alphanum)?}; $hostname = qq{(?:$domainlabel\\.)*$toplabel\\.?}; $host = qq{(?:$hostname|$IPv4address)}; $hostport = qq{$host(?::$port)?}; $user = q{(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|} . qq{$escaped)*}; $password = $user; $userinfo = qq{$user(?::$password)?}; $server = qq{(?:$userinfo\@)?$hostport}; $authority = qq{$server}; $scheme = q{ftp}; $net_path = qq{//$authority(?:$abs_path)?}; $hier_part = qq{$net_path(?:\\?$query)?}; $absoluteURI = qq{$scheme:$hier_part}; $URI_reference = qq{$absoluteURI(?:#$fragment)?}; $ftp_URL_regex = q{\b} . $URI_reference;
ftp URL については RFC 1738 に書かれています．ただし，現在では RFC 1738 は RFC 2396( 日本語訳 )によって更新されています．更新されていると言っても RFC 2396 は URI の一般形を定義したものになっているので， ftp URL の定義について直接書かれている部分はありません．そこで，ftp URLの正規表現として，RFC 2396 の URI の一般形の定義をもとに，﹁http URL の正規表現﹂でスキームが http である URI References として求めた方法と同様の方法で，スキームが ftp である URI References を考えます． RFC 1738 に書かれている ftp URL の定義を考慮して書き換えた部分は以下のようになります．

$segment = qq{$pchar*};
$ftptype = q{[AIDaid]};
$path_segments = qq{$segment(?:/$segment)*(?:;type=$ftptype)?};
$user = q{(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|} . qq{$escaped)*};
$password = $user;
$userinfo = qq{$user(?::$password)?};
$server = qq{(?:$userinfo\@)?$hostport};
$authority = qq{$server};
$scheme = q{ftp};
$net_path = qq{//$authority(?:$abs_path)?};
$hier_part = qq{$net_path(?:\\?$query)?};
$absoluteURI = qq{$scheme:$hier_part};
$URI_reference = qq{$absoluteURI(?:#$fragment)?};
$ftp_URL_regex = q{\b} . $URI_reference;

ftp URL は RFC 1738 で ftpurl = "ftp://" login [ "/" fpath [ ";type=" ftptype ]] と定義されています．login より後ろの部分は path_segments に当たるわけですが， ; は fpath とその後ろの部分を区切る目的で使用されます．そこで，segment から ; と param を削除し，path_segments を ftp URL の定義に適合するように修正しました．同様に login 部分は login = [ user [ ":" password ] "@" ] hostport と定義されており， userinfo は user [ ":" password ] となっています．つまり，: が user と password を区切る目的で使用されるため，userinfo から : を取り除いたものを新たに user，password として定義し userinfo を修正しました． scheme は当然 ftp であり，スキームが ftp である URI References としてはあり得ない選択部分を削除するなどして URI_reference や absoluteURI などを修正しました．このスクリプトから求めた ftp URL の正規表現は次のようになりました． \bftp://(?:(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])* (?::(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?@)?(? :(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)*[a-zA-Z](?:[-a-zA- Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)? (?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:/(? :[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(?:;type=[ AIDaid])?)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9 A-Fa-f])*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A -Fa-f])*)?
以下がこれを直接代入して使うスクリプトになります． $ftp_URL_regex = q{\bftp://(?:(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} . q{(?::(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?@)?(?} . q{:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)*[a-zA-Z](?:[-a-zA-} . q{Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)?} . q{(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:/(?} . q{:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(?:;type=[} . q{AIDaid])?)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9} . q{A-Fa-f])*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A} . q{-Fa-f])*)?};
トップへ

メールアドレスの正規表現

ここの記述は内容が古くなっているので，こちらに新しく書き起こしました． 以降の記述は参考に残しておきます．

RFC 2821 と RFC 2822 は RFC 5321 と RFC 5322 によって obsolete となりました． RFC 821 と RFC 822 は RFC 2821( 日本語訳 1～3章 4,5章 6章～ )と RFC 2822( 日本語訳 )によって obsolete となりました．メールアドレスについては RFC 821( 日本語訳 )と RFC 822( 日本語訳 )に書かれています．perl5.6.0以前の perl ではメールアドレスの正規表現を正確に記述することはできませんでした．Jeffrey E. F. Friedl氏原著による﹁詳説正規表現﹂にはメールアドレスはネストしたコメントを持つことができるので正規表現で表わすのは不可能であると書いてあります．そこで，Jeffrey E. F. Friedl氏はネストしたコメントをあきらめて，次のような 6,598バイトにも及ぶ正規表現を作っています． https://resources.oreilly.com/examples/9781565922570/blob/master/email-opt.pl にソースコードがあります．

[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x
80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\
\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:(?:[^(\040)<>@,;:".\\\[\]\000
-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\
\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\04
0\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\
xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80
-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\0
15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x
ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]
*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:"
.\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xf
f][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(
?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\
\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*@[
\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x8
0-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\
x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\03
7\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\
\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\x
ff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\
x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\
040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-
\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\01
5()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:"
.\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-
\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(
?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\
015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\
n\015()]*)*\)[\040\t]*)*)*|(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-
\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff
\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>@,;:".\\
\[\]\x80-\xff\000-\010\012-\037]*(?:(?:\([^\\\x80-\xff\n\015()]*(?
:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\
x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)|"[^\\\x80-\xff\
n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>@,;:".\\\
[\]\x80-\xff\000-\010\012-\037]*)*<[\040\t]*(?:\([^\\\x80-\xff\n\0
15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x
ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]
*)*(?:@[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\
([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*
\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]
\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|
\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\
\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*
(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()
]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\
\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\
xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040
)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\
037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\
040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80
-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x
80-\xff\n\015()]*)*\)[\040\t]*)*)*(?:,[\040\t]*(?:\([^\\\x80-\xff\
n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80
-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
\t]*)*@[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\
([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*
\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]
\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|
\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\
\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*
(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()
]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\
\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\
xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040
)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\
037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\
040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80
-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x
80-\xff\n\015()]*)*\)[\040\t]*)*)*)*:[\040\t]*(?:\([^\\\x80-\xff\n
\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-
\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\
t]*)*)?(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80
-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015(
)]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff]
[^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*
(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([
^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\)
)[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\0
00-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[
^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\
040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80
-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x
80-\xff\n\015()]*)*\)[\040\t]*)*)*@[\040\t]*(?:\([^\\\x80-\xff\n\0
15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x
ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]
*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:"
.\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80
-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xf
f]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()
]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^
\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]
*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015(
)]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?!
[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\01
5\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:
(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x
80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*>)

email-opt.pl を元に冗長部分を削り落としたのが以下のスクリプトです．冗長部分を削り落としてもかなりの量です． (注意‥$ctrl は本当は '\000-\037\0177' の間違いです) (注意‥正確には，RFC822 では $CRlist に \n は含まれていません) # $email が正しいメールアドレスか判定する $esc = '\\\\'; $Period = '\.'; $space = '\040'; $tab = '\t'; $OpenBR = '\['; $CloseBR = '\]'; $OpenParen = '$'; $CloseParen = '$'; $NonASCII = '\x80-\xff'; $ctrl = '\000-\037'; $CRlist = '\n\015'; $qtext = qq/[^$esc$NonASCII$CRlist\"]/; $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/; $quoted_pair = qq<${esc}[^$NonASCII]>; $ctext = qq<[^$esc$NonASCII$CRlist()]>; $Cnested = qq<$OpenParen$ctext*(?:$quoted_pair$ctext*)*$CloseParen>; $comment = qq<$OpenParen$ctext*(?:(?:$quoted_pair|$Cnested)$ctext*)*$CloseParen>; $X = qq<[$space$tab]*(?:${comment}[$space$tab]*)*>; $atom_char = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/; $atom = qq<$atom_char+(?!$atom_char)>; $quoted_str = qq<\"$qtext*(?:$quoted_pair$qtext*)*\">; $word = qq<(?:$atom|$quoted_str)>; $domain_ref = $atom; $domain_lit = qq<$OpenBR(?:$dtext|$quoted_pair)*$CloseBR>; $sub_domain = qq<(?:$domain_ref|$domain_lit)$X>; $domain = qq<$sub_domain(?:$Period$X$sub_domain)*>; $route = qq<\@$X$domain(?:,$X\@$X$domain)*:$X>; $local_part = qq<$word$X(?:$Period$X$word$X)*>; $addr_spec = qq<$local_part\@$X$domain>; $route_addr = qq[<$X(?:$route)?$addr_spec>]; $phrase_ctrl = '\000-\010\012-\037'; $phrase_char = qq/[^()<>\@,;:\".$esc$OpenBR$CloseBR$NonASCII$phrase_ctrl]/; $phrase = qq<$word$phrase_char*(?:(?:$comment|$quoted_str)$phrase_char*)*>; $mailbox = qq<$X(?:$addr_spec|$phrase$route_addr)>; print "ok\n" if $email =~ /^$mailbox$/o;
perl5.6.0以前の perl では表現できなかったネストしたコメント部分は，このスクリプトでは $Cnested と $comment の代入文で定義されており， 1回だけネストを許した正規表現となっています．この 2つの代入文を以下のように変更することでメールアドレスの正規表現を正確に記述することができるようになります． use re 'eval'; $comment = qr<$OpenParen$ctext*(?:(?:$quoted_pair|(??{$comment}))$ctext*)*$CloseParen>;
ただし，ここで使用している正規表現 (??{ code }) は実験的なものなので今後変更されたり削除されるかもしれませんので注意が必要です．また， use re 'eval'; しているので，この点にも十分注意する必要があります．何をどう注意する必要があるのかはマニュアルを読んでください．メールアドレスのパターンマッチが終わった時点で no re 'eval'; しておくことをお勧めします．メールアドレスが正しいかどうかを調べるにはモジュール Email::Valid またはモジュール Mail::CheckUser を使うのがいいと思います．このモジュールを使えば，メールアドレスが RFC 822 に書かれている文法的に正しいかどうかだけではなく，そのメールアドレスが実際に有効かどうかもある程度調べることができます．ただし，その場合はもちろんインターネットに接続されている必要があります．詳しい使い方はマニュアルを読んでください．さて，ここまでで書いてきたメールアドレスというのは From行などで指定できるもののことでして，RFC 822 においては mailbox として定義されています．この mailbox をある文字列からメールアドレスを抽出する目的で使うのは無茶というものです．そのような目的のときに必要とされるのは mailbox ではなく， addr-spec の方でしょう．mailbox や addr-spec がどのようなものかと言いますと，たとえば， Foo Bar <foobar@example.com> というのは mailbox ですが addr-spec ではありません． foobar@exmaple.com というのは addr-spec だけから成る mailbox になります．そこで先ほどのスクリプトを修正し，ある文字列からメールアドレスを抽出する目的で使うための addr-spec の正規表現を以下のように作りました． # メールアドレスの正規表現 $mail_regex $esc = '\\\\'; $Period = '\.'; $space = '\040'; $OpenBR = '\['; $CloseBR = '\]'; $NonASCII = '\x80-\xff'; $ctrl = '\000-\037'; $CRlist = '\n\015'; $qtext = qq/[^$esc$NonASCII$CRlist\"]/; $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/; $quoted_pair = qq<${esc}[^$NonASCII]>; $atom_char = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/; $atom = qq<$atom_char+(?!$atom_char)>; $quoted_str = qq<\"$qtext*(?:$quoted_pair$qtext*)*\">; $word = qq<(?:$atom|$quoted_str)>; $domain_ref = $atom; $domain_lit = qq<$OpenBR(?:$dtext|$quoted_pair)*$CloseBR>; $sub_domain = qq<(?:$domain_ref|$domain_lit)>; $domain = qq<$sub_domain(?:$Period$sub_domain)*>; $local_part = qq<$word(?:$Period$word)*>; $addr_spec = qq<$local_part\@$domain>; $mail_regex = $addr_spec;
このスクリプトは，先ほどのスクリプトから，途中にコメントとスペースやタブがないように変更し，冗長部分を削除したものです．このスクリプトから求めた addr-spec は以下のようになりました． (?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\ \[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][ ^\\\x80-\xff\n\015"]*)*")(?:\.(?:[^(\040)<>@,;:".\\\[\]\000-\037\x 80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\ xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*"))*@(?:[^(\0 40)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000 -\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]) (?:\.(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,; :".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x 80-\xff])*\]))*
以下がこれを直接代入して使うスクリプトになります． $mail_regex = q{(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\} . q{\[\]\000-\037\x80-\xff])|"[^\\\\\x80-\xff\n\015"]*(?:\\\\[^\x80-\xff][} . q{^\\\\\x80-\xff\n\015"]*)*")(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x} . q{80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff])|"[^\\\\\x80-} . q{\xff\n\015"]*(?:\\\\[^\x80-\xff][^\\\\\x80-\xff\n\015"]*)*"))*@(?:[^(} . q{\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\0} . q{00-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[^\x80-\xff])*} . q{\])(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,} . q{;:".\\\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[} . q{^\x80-\xff])*\]))*};
このメールアドレスの正規表現 $mail_regex を使って，$email が正しいメールアドレスか判定するには次のように書きます． perl5.004以前の場合は \z の部分を $(?!\n) に置き換えてください．

# $email が正しいメールアドレス(addr_spec)か判定する

if ($email !~ /^$mail_regex\z/o) {
  print "不正なメールアドレスです\n";
}

余談ですが，DoCoMo(i-mode) と J-Phone(J-Sky) ではメールアドレスとして irregular.@docomo.ne.jp のように @ の直前が .(ピリオド) であるものも使用できます．しかし，これは RFC 822 に適合しない不正なメールアドレスです．@ の前の local-part の部分では .(ピリオド) は必ず他の文字に挟まれていなければならないのです．したがって， .(ピリオド) が先頭にある場合と，@ の直前にある場合は不正なメールアドレスということになります． DoCoMo(i-mode)同士や J-Phone(J-Sky)同士でのメールのやりとりであれば問題ありませんが，そうでなければ使用するべきではありません．トップへ

日本語を扱う

perl スクリプトは EUC-JP で書く

perl で日本語を扱うにはいろいろと注意しなければならないことがあります．なぜなら，日本語の文字コードには perl が特別な意味として解釈してしまう文字が含まれているからです．たとえば，perl スクリプトを JIS で次のように書いたとします．

$str = "このTESTで充分";
$str =~ s/このTESTで充分/このテストで十分/;  # JIS でも SJIS でも駄目
print $str, "\n";

これを正常に実行することはできません． unmatched () in regexp となってしまうはずです．なぜなら，エスケープシーケンスの ESC (B が含まれているために，( をグループ化のための開き括弧として解釈してしまうからです．もちろん，このエラーは閉じ括弧の ) がないために括弧が対応していないというエラーです．それではこのスクリプトを SJIS で書いた場合はどうでしょう．今度は unmatched [] in regexp となってしまうはずです．なぜなら SJIS の﹁充﹂の文字コードは 0x8F 0x5B であり，0x5B というのは ASCII の [ の文字コードであるからです．そこで SJIS の場合には正規表現でエラーにならないように，次のようにパターンの部分を \Q と \E で挟んでエスケープするという回避方法があります．

$str = "このTESTで充分";
$str =~ s/\QこのTESTで充分\E/このテストで十分/;  # これで SJIS でも大丈夫？
print $str, "\n";

ところが，これを実際に実行してみると文字化けしてしまいます．なぜなら，SJIS の﹁十﹂の文字コードは 0x8F 0x5C であり，0x5C というのは ASCII の \ の文字コードであるため，﹁分﹂の 1バイト目と合わせて特別な意味として解釈しようとするためです．\ と﹁分﹂の 1バイト目を合わせたエスケープシーケンスというものはありませんので，結果的に﹁十﹂の 2バイト目の \ は無視されることになります．このように SJIS には 2バイト目が \ である文字があるために文字化けしてしまいます．同様に，2バイト目が @ である文字では配列と解釈されてしまうことがあります． 2バイト目が \ である文字については，その後ろに \ を書けば回避することができますが，2バイト目が @ である文字についてはさらに別の回避手段を取らざるを得なくなります．ちなみに，SJIS で 2バイト目が \ である文字は﹁―ソЫ噂浬欺圭構蚕十申曾箪貼能表暴予禄兔喀媾彌拿杤歃濬畚秉綵臀藹觸軆鐔饅鷭﹂です．また，2バイト目が @ である文字は全角スペースと﹁ァА院魁機掘后察宗拭繊叩邸如鼻法諭蓮僉咫奸廖戞曄檗漾瓠磧紂隋蕁襦蹇錙顱鵝﹂です．これらの文字以外にも SJIS では問題となる文字がまだまだあります．なお，さきほど SJIS の場合に \Q と \E で挟んでエスケープするという回避方法について触れましたが，実はこの方法は完全ではありません．たとえば，次のスクリプトを見てください．

if ($str =~ /\Q$keyword\E/) {
  print "マッチした\n";
}

このスクリプトのように，あるキーワード $keyword を \Q と \E で挟めばエラーにならずにうまくパターンマッチできるという話があります．たしかにエラーにはなりませんが，たとえば SJIS で $str = 'テスト'; のときに $keyword = 'X'; でパターンマッチを行なうとマッチしてしまいます．これは SJIS の﹁ス﹂の文字コードが 0x83 0x58 であり，0x58 というのが ASCII のXの文字コードであるためです．また， $str = 'ｃａ＜ｂ'; のときに $keyword = 'モ＝モ'; のときもマッチしてしまいます．これは﹁ｃａ＜ｂ﹂という文字列の文字コード 0x82 0x83 0x82 0x81 0x81 0x83 0x82 0x82 に対して， 1バイトずつずれた位置で﹁モ＝モ﹂という文字列の文字コード 0x83 0x82 0x81 0x81 0x83 0x82 がマッチしてしまうからです． perl で日本語を扱うための手段の1つが jperl を使うということです． jperl はオリジナルの perl にパッチをあてて，日本語を扱えるようにしたものです． Windows用の jperl は以下の場所(鈴木紀夫さん提供)から入手することができます． http://homepage2.nifty.com/kipp/perl/jperl/ それでは最初のスクリプトを EUC-JP で書いた場合はどうでしょうか．EUC-JP で書いた場合には正常に実行できるはずです．なぜなら，EUC-JP には JIS や SJIS のように perl が特別な意味として解釈してしまうような文字が含まれていないからです．perl で日本語を扱うには perl スクリプトを EUC-JP で書くのが一番簡単な方法です．以下では，EUC-JP でスクリプトを書くことを前提としています．実は EUC-JP のパターンマッチにおいても SJIS と同じように間違ってマッチしてしまう場合があります．このことについては﹁正しくパターンマッチさせる﹂を参照してください．トップへ

漢字コードを EUC-JP に変換して処理する

perl スクリプトは EUC-JP で書いたとしても，入力した日本語の漢字コードが SJIS や JIS では正常な動作を期待することはできません．そこで何らかの処理を行なうときには一度 EUC-JP に変換してから行ないます．perl スクリプトを EUC-JP で書き，漢字コードが EUC-JP である日本語を処理するというのが，perl で日本語を扱うときに一番問題が起きにくい方法です．入力した日本語の漢字コードが EUC-JP ではない場合，または，漢字コードがわからない場合には，漢字コードを jcode.pl (歌代和正さん作)を使って EUC-JP に変換してあげます． $str を EUC-JP に変換するには次のように書きます． # $str を EUC-JP に変換する require 'jcode.pl'; jcode::convert(\$str, 'euc');
'euc' の部分を 'sjis' や 'jis' にすれば， SJIS や JIS に変換できます．もし，入力した日本語の漢字コードが $code であるとわかっている場合には，次のように明示的に指定することで内部で自動判別しないようにすることができます． # 漢字コードが $code である $str を EUC-JP に変換する require 'jcode.pl'; jcode::convert(\$str, 'euc', $code);
﹁漢字コードを調べる﹂で自動判別の判定精度を上げて求めた $code を使いたいときにもこの書式を使います．余談ですが，次のように my 宣言された変数に対して，型グロブを使って変換しようとするのは間違いです．

# my 宣言された変数を変換するときの間違った例

require 'jcode.pl';

my $str = 'my 宣言された変数の型グロブはない';

jcode::convert(*str, 'euc');

my 宣言された変数の型グロブはないので，これでは変換することはできません． my宣言された変数のハードリファレンスは求めることができるので，最初のスクリプトのように常に \$str のように書くのが一番問題の起きにくい書き方です．

jcode.pl は以下の場所に最新バージョンが置いてあります． ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/ 現在の最新バージョンは jcode.pl-2.13 です．これを取ってきて jcode.pl に名前を変更して使います． jcode.pl の使い方は jcode.pl の中に書かれています．よくわからなければ，小塚敦さんによる﹁jcode.pl の私的な解説書﹂を読むといいかもしれません． Jcode.pm - jcode.pl の後継(小飼弾さん作)というものも公開されています． Jcode.pm は UNICODE に対応していますが，使用するには jcode.pl のようにコピーするだけでは駄目で，ちゃんとインストールする必要があります．なお，Windows用の perl である ActivePerl 5.6用に，コンパイル済みのパッケージが以下の場所(鈴木紀夫さん提供)で配布されています． http://homepage2.nifty.com/kipp/perl/Jcode/index.html バージョン 2.10以前の jcode.pl はスレッドが有効になっている perlでは使用することができません．スレッドが有効になっている perl では特殊変数 $_ や @_ はレキシカル変数となります．レキシカル変数とは my 宣言された変数のことです．このレキシカル変数というのは local 宣言することができないのですが，バージョン 2.10以前の jcode.pl では関数の引数を local 宣言した型グロブ *_ に代入しようとしているために正常に動作しません．最新バージョンの jcode.pl 及び Jcode.pm はスレッドが有効になっている perl でも正常に動作します．手元の perl のスレッドが有効になっているかどうかを調べるには perl -V と入力し実行します．このとき usethreads=undef となっていれば無効になっているので jcode.pl を安心して使うことができます． perl5.005より前の perl もスレッド機能がないので問題ありません．もし，スレッドが有効になっていた場合にはバージョン 2.10以前の jcode.pl が使えないことはもちろんのこと，特殊変数 $_ や @_ がレキシカル変数になっていることにも注意してスクリプトを書く必要があります．トップへ

漢字コードを調べる

# $str の漢字コードを調べる require 'jcode.pl'; ($match, $code) = jcode::getcode(\$str); $code = 'euc' if $code eq undef and $match > 0;
jcode.pl の getcode 関数を使います． $code には 'euc' や 'sjis'，'jis' といった文字列が入っています．詳しくは jcode.pl の中の説明を読んでください．ここで注意が必要なのは，漢字コードを正確に調べることには限界があるということです．SJIS の漢字(第二水準)の一部や SJIS の半角カタカナ 2文字は EUC-JP の漢字 1文字と区別がつきません．もし，漢字コードが EUC-JP か SJIS の両方の可能性があり，どちらか判断できないときには jcode::getcode() は undef を返します．ただ，厳密にはどちらか判断できないとは言え，半角カタカナが含まれていない場合にはほとんどの場合 EUC-JP であるので，上のスクリプトでは最終的に undef ではなく EUC-JP としています． jcode::getcode() は SJIS の半角カタカナを考慮せずに判定しています．このため，SJIS だと判断できる半角カタカナが含まれている文字列でも EUC-JP と間違ってしまうことがあります．そこで，次のように書くことで判定精度を上げることができます． # $str の漢字コードを調べる require 'jcode.pl'; ($match, $code) = jcode::getcode(\$str); $code = 'euc' if $code eq undef and $match > 0; $ascii = '[\x00-\x7F]'; if ($code eq 'euc') { if ($str !~ /^(?:$jcode::re_euc_c|$jcode::re_euc_kana| $jcode::re_euc_0212|$ascii)*$/ox) { if ($str =~ /^(?:$jcode::re_sjis_c|$jcode::re_sjis_kana|$ascii)*$/o) { $code = 'sjis'; } } }
これで SJIS を EUC-JP と間違って判定する可能性を減らすことができますが，その分処理に時間がかかってしまうことを忘れてはいけません．このようにして自動判定の判定精度を上げて求めた $code は漢字コードを変換するときにも利用することができます．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照．トップへ

全角文字が含まれているか判定する

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $str に全角文字(半角カタカナを含まない)が含まれているか判定する if ($str =~ /[\xA1-\xFE][\xA1-\xFE]/) { print "含まれている\n"; }
全角文字は JIS X 0208 と JIS X 0212 なので，半角カタカナである JIS X 0201片仮名は含みません．全角文字が含まれているかどうかを判定するには，JIS X 0208 と JIS X 0212 の共通部分であり，ASCII や JIS X 0201片仮名では現れないパターン /[\xA1-\xFE][\xA1-\xFE]/ を使って判定します． # $str に半角カタカナが含まれているか判定する if ($str =~ /\x8E/) { print "含まれている\n"; }
半角カタカナが含まれているかどうかを判定するには，EUC-JP では /\x8E/ を調べるだけでできます． # $str に ASCII 以外が含まれているか判定する if ($str =~ /[\x8E\xA1-\xFE]/) { print "含まれている\n"; }
ASCII 以外の文字が含まれているかを判定するには， /[\x8E\xA1-\xFE]/ を調べることでできます． \x8E があれば JIS X 0201片仮名の 1バイト目でマッチし， [\xA1-\xFE] があれば JIS X 0208 の 1バイト目か， JIS X 0212 の 2バイト目でマッチしますので， ASCII 以外の文字が含まれていることがわかります． $str が EUC-JP かどうかもわからないときは jcode.pl を使って調べることもできます． jcode.pl を使って﹁漢字コードを調べる﹂で書いたスクリプトで $str の漢字コードを調べた結果が undef の場合は ASCII 以外の文字は含まれていないとすることができます．逆に言えば，undef ではない場合は ASCII 以外の文字が含まれているとすることができます．このとき，次のように慌てて $match を使わずに，いきなり undef かどうかを調べる方法は間違っています．

# $str に ASCII 以外が含まれているか判定するときの間違った例

require 'jcode.pl';
$code = jcode::getcode(\$str);

if ($code eq undef) {
  print "ASCII以外は含まれていない\n";
  print "この判断は間違い\n";
}

jcode::getcode() は EUC-JP か SJIS の両方の可能性があり，どちらか判断できないときにも undef を返します．﹁漢字コードを調べる﹂で書いてあるように $match を使って undef の場合を処理する必要があります．トップへ

文字が途切れているか判定する

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $str の最後の文字が途切れているか判定する if ($str =~ /\x8F$/ or $str =~ tr/\x8E\xA1-\xFE// % 2) { print "最後の文字が途切れている\n"; }
EUC-JP で文字が途切れる可能性があるのは，JIS X 0201片仮名(半角カタカナ)とJIS X 0208(全角文字)と JIS X 0212(補助漢字)です． JIS X 0212 は 3バイトで表わされ，最初が \x8F で始まります．最初の条件は $str が \x8F で終わっていた場合，すなわち，JIS X 0212 が 1バイト目で途切れていた場合を表わしています．次の条件が JIS X 0201片仮名と JIS X 0208 が 1バイト目で途切れていた場合と，JIS X 0212 が 2バイト目で途切れていた場合です． tr/\x8E\xA1-\xFE// は $str の中の，JIS X 0201片仮名と JIS X 0208 の 1バイト目と 2バイト目， JIS X 0212 の 2バイト目と 3バイト目の数を数えています．この数がもし奇数ならば文字が途切れていることがわかります．トップへ

全角英数字を半角英数字に変換する

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $str の全角英数字を半角英数字に変換する require 'jcode.pl'; jcode::tr(\$str, '０-９Ａ-Ｚａ-ｚ', '0-9A-Za-z');
jcode.pl の tr関数を使います．この関数は全角文字に対応した tr です．詳しくは jcode.pl の中の説明を読んでください．基本的に tr なので，全角英数字以外にも全角スペースを半角スペースにするなどの変換も次のように書くことで簡単にできます． # $str の全角スペースなどを半角スペースなどに変換する require 'jcode.pl'; jcode::tr(\$str, '　（）＿＠－', ' ()_@-');
逆に，第1引数と第2引数を逆にすれば，半角文字を全角文字にすることもできます．半角カタカナと全角カタカナの相互変換に関しては﹁半角カタカナを全角カタカナに変換する﹂を参照．トップへ

半角カタカナを全角カタカナに変換する

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $str の半角カタカナを全角カタカナに変換する require 'jcode.pl'; jcode::h2z_euc(\$str);
jcode.pl の h2z_euc 関数を使います．トップへ

正しくパターンマッチさせる

$str および $pattern は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては「漢字コードを EUC-JP に変換して処理する」を参照．

perl で日本語を扱う場合にはスクリプトを EUC-JP で書き，漢字コードが EUC-JP である日本語を処理するというのが一番問題が起きにくい方法であるということを「perl スクリプトは EUC-JP で書く」と「漢字コードを EUC-JP に変換して処理する」で述べました．しかし，それだけでは少し困ったことが起きることがあります．たとえば，次のようなスクリプトを実行すると間違ってマッチしてしまいます．

# 間違ってマッチしてしまう例

$str = 'これはテストです';
$pattern = '好';

if ($str =~ /$pattern/) {
  print "マッチした\n";
}

なぜこのようなことが起きてしまうのかというと，EUC-JP の「ス」の文字コードは 0xA5 0xB9，「ト」は 0xA5 0xC8，「好」は 0xB9 0xA5 であり，ちょうど「スト」の真ん中の部分が「好」と同じになるのでマッチしてしまうのです．このようにずれた場所でマッチしてしまっては困る場合には次のように書きます．

# $str に $pattern を正しくマッチさせる $ascii = '[\x00-\x7F]'; $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]'; $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]'; if ($str =~ /^(?:$ascii|$twoBytes|$threeBytes)*?(?:$pattern)/) { print "マッチした\n"; }

なぜこのような書き方になるのか説明します．最初の間違ってマッチしてしまうスクリプトでは /$pattern/ というように無造作にマッチさせようとしたためにずれた場所でマッチしてしまいました．そこで，ずれた場所でマッチしないようにするには，$pattern の前には日本語の文字が何文字かあって，その後に $pattern がくるということを明示的に書いてあげる必要があります．EUC-JP での 1文字というのは 1バイト文字である ASCII， 2バイト文字である JIS X 0201片仮名(半角カタカナ)と JIS X 0208(全角文字)，3バイト文字である JIS X 0212(補助漢字)のことです．これを正規表現で表わしたのが (?:$ascii|$twoBytes|$threeBytes) の部分です．この文字が文字列の先頭から何文字か続いた後に $pattern がくるということを正規表現で書いたのが上のスクリプトです．正規表現で任意の一文字を表わすには普通 .(ピリオド)を使いますが，日本語の文字列に対するマッチングでは， .(ピリオド) で書きたくなる場所を (?:$ascii|$twoBytes|$threeBytes) とすればいいことになります．最初のスクリプトの /$pattern/ も /^.*?(?:$pattern)/ だと思えば上のスクリプトのようになるのも納得していただけるのではないでしょうか．日本語の文字列に対して正しくマッチさせる方法として，これまで書いてきたように EUC-JP での 1文字というものをちゃんと意識して正規表現を書くという方法以外に，あらかじめマッチさせる前に 2バイト文字と 3バイト文字の後ろに文字の区切りがわかるように区切り文字をつけておくという方法があります．具体的には次のように，マッチの対象となっている日本語の文字列 $str と，マッチさせようとしているパターン $pattern の両方に区切り文字をつける処理をしてからマッチングを行ないます．このスクリプトでは区切り文字として \000 を使っています．

# 区切り文字をつけて正しくマッチさせる(非常に遅い)

$twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
$threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';

$pattern =~ s/($twoBytes|$threeBytes)/$1\000/og;
$str =~ s/($twoBytes|$threeBytes)/$1\000/og;

if ($str =~ /$pattern/) {
  print "マッチした\n";
}

この方法ではマッチさせる前に区切り文字をつける処理を行なうことで，正規表現そのものは普通に書くことができます．この方法はわかりやすいところはいいのですが，おそらくほとんどの場合区切り文字を使わない最初のスクリプトよりも実行速度が遅いでしょう．この 2つ方法の特徴を考えてみます．区切り文字を使わない方法は，前処理なしにすぐにパターンマッチを始めることができる．しかし，パターンマッチそのものは正規表現が複雑なため少し遅い．区切り文字を使った方法は，あらかじめ文字列全体に対し区切り文字を入れる前処理を行なう必要がある．ただ，パターンマッチそのものは正規表現が複雑にならないために速い．それでは実際に比較したらどうなるか調べてみました．パターンマッチが成功しなかった場合，文字列全体に対し検索を行なうことになりますが，私がベンチマークをとってみたところ，区切り文字を使わない方法の方が圧倒的に速かった (約15倍) です．パターンマッチが成功する場合には，文字列の途中で検索を止めることができるので，文字列全体に対して必ず前処理を行なわなければならない区切り文字を使った方法の方が遅いことは言うまでもありません．結局，区切り文字を使わない方法は正規表現が複雑になった分パターンマッチそのものは少し遅くなりますが，区切り文字を使う方法の方は，いかんせん区切り文字を入れる処理が遅すぎてパターンマッチそのものの速さが全然活きなかったようです．この結果からすると，データの中からマッチするものだけ取り出すような処理には明らかに区切り文字を使わない最初のスクリプトの方がいいと言えます．区切り文字を使った方法の方がいい場合としては，前処理の遅さをパターンマッチの速さで補えるほど何度も同じ文字列に対してパターンマッチを行なう場合です．もちろん，これら実行速度に関しては環境に依存する話ですので，実際に自分の環境で試してみるのがいいでしょう．次に，日本語の文字列を正しく置換する方法について説明します．次のようなスクリプトが間違って置換してしまうということはすでに説明したとおりです．

# 間違って置換してしまう例

$str = 'これはテストです';
$pattern = '好';
$replace = '嫌';

$str =~ s/$pattern/$replace/g;

次のように書くことで正しく置換することができます． # $str の $pattern を $replace に正しく置換する $ascii = '[\x00-\x7F]'; $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]'; $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]'; $str =~ s/\G((?:$ascii|$twoBytes|$threeBytes)*?)(?:$pattern)/$1$replace/g;
このスクリプトの基本的な考え方は，EUC-JP での 1文字というものをちゃんと意識して正規表現を書くマッチの方法と同じです．ただ，マッチさせるだけの場合と違うのは $1 と \G を使っているところです． $1 を使うのは，置換する部分をマッチさせるときに $pattern の前にある文字もいっしょにマッチさせることになるため，この部分を置換せずにそのまま残してあげる必要があるからです．そこで $pattern の前の部分に当たる正規表現 (?:$ascii|$twoBytes|$threeBytes)*? を括弧で囲って $1 で参照できるようにしています．次に \G の説明をします． \G を使うのは修飾子 g がつけられているためです．修飾子 gは，マッチするかどうか判定するだけならば必要ないですし，また，1回しか置換しない場合も必要ありません．そのときは修飾子 gをつけるのをやめて， \G を文字列の先頭にマッチする ^ に変えることができます．逆に言えば，修飾子 gをつけて $str の中の $pattern をすべて置換したいときに，文字列の先頭にだけマッチする ^ を使うことができないということです．\G は修飾子 gがつけられているときに，パターンマッチの開始位置にマッチします．つまり，\G は一番最初は ^ と同じで，次からは $pattern のすぐ後ろでマッチします．わかりやすく簡単に言うと，\G はマッチするかどうかこれから調べようとしている残りの部分の先頭にマッチすると言えます．\G を使うことで，ずれた位置で $pattern がマッチすることがないようになります．置換の場合にも次のように区切り文字をつけて正しく置換する方法があります．

# 区切り文字をつけて正しく置換させる(非常に遅い)

$twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
$threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';

$pattern =~ s/($twoBytes|$threeBytes)/$1\000/og;
$str =~ s/($twoBytes|$threeBytes)/$1\000/og;

$str =~ s/$pattern/$replace/g;
$str =~ tr/\000//d;
# $str =~ s/($twoBytes|$threeBytes)\000/$1/og;

基本的に区切り文字をつけて正しくマッチさせる方法と同じです．ただ，マッチさせるだけの場合と違って，置換後に区切り文字を削除する必要があります．このスクリプトでは区切り文字に \000 を使っていて，置換後にこの区切り文字を trを使って削除しています．ところが， $str の中に初めから含まれていた \000 もいっしょに削除してしまいます． tr を使って削除できるのは $str の中に区切り文字と同じ \000 が含まれていないという前提が必要です．もし， $str の中に \000 が含まれているかもしれない場合には tr を使って区切り文字を削除するのを止めて， $str =~ tr/\000//d; を $str =~ s/($twoBytes|$threeBytes)\000/$1/og; に変更します．実行速度について 2つの方法を比較してみました．与えた文字列に対して全く置換するところがなかった場合には，区切り文字を使わない方法の方が圧倒的に速かった (約35倍) です．全部の文字を置換する必要がある文字列を与えた場合でも，区切り文字を使わない方法の方が 4割程度速かったです．もし，区切り文字を使う場合の方法で後処理に tr を使わなかった場合には更にスピード差が出るでしょう．結局，置換の場合でも区切り文字を使う場合は，前処理と後処理に時間がかかりすぎるということが言えます．実行速度に関しては環境に依存する話なので，どちらが速いか自分の環境で試してみるのが一番だということは言うまでもありません．さて，ここまでの話では $pattern は Perl の文法的に正しい正規表現という前提でした．ですから，たとえば開き括弧 ( にマッチさせたい場合には \( というようにエスケープする必要があります．CGI などにおいて，ユーザ入力の文字列でマッチするものを検索したい場合などには，入力された文字列を正規表現として解釈するのではなく，その文字列そのもので検索したい場合がほとんどでしょう．そのようなときに， $pattern としてパターンマッチを行なうと，先ほどの例で挙げた開き括弧 ( などが入力されたときに正規表現として正しくないとエラーになってしまいます．そこで正規表現で特別な意味として解釈される開き括弧などのメタ文字はエスケープしてパターンマッチさせる必要があります．そのためには，ユーザ入力 $keyword に対して，これまでに書いたスクリプトの $pattern の部分を \Q$keyword\E に変更して，パターンマッチの場合は， if ($str =~ /^(?:$ascii|$twoBytes|$threeBytes)*?\Q$keyword\E/) { print "マッチした\n"; }
置換の場合は， $str =~ s/\G((?:$ascii|$twoBytes|$threeBytes)*?)\Q$keyword\E/$1$replace/g;
というようにします．\Q から \E までメタ文字が無視されるようになります．次に実行速度を上げるための方法を 1つ書いておきます．これまで書いてきたように，日本語の文字列に対して正しくマッチさせたり置換するためには少々複雑な正規表現を使う必要があります．そのため，その複雑になった分だけ実行速度が遅くなってしまいます．これは，大量のデータの中から検索したり置換したりする場合には非常に時間がかかるようになってしまうことを意味します．ここで少し考えてみてください．大量のデータの中から検索するとき，そのほとんどの場合はマッチしないのです．つまり，マッチしないのですから正しくマッチさせる必要はないのです．そこで $pattern を検索したいときには，次のようにすることでほとんどの場合実行速度を上げることができます． if ($str =~ /$pattern/) { if ($str =~ /^(?:$ascii|$twoBytes|$threeBytes)*?(?:$pattern)/) { print "マッチした\n"; } }
$keyword の場合は， /\Q$keyword\E/ という正規表現は使わずに次のように index 関数を使います． if (index($str, $keyword) > -1) { if ($str =~ /^(?:$ascii|$twoBytes|$threeBytes)*?\Q$keyword\E/) { print "マッチした\n"; } }
index 関数は正規表現に比べて実行速度が圧倒的に速いので，なんでもかんでも正規表現ではなく，index 関数が使えないか常に考えたいものです． ※上記の内容について最近の perl(perl5.8.8等)では，index 関数を使うよりも， /\Q$keyword\E/ という正規表現を使った方が速いようです．実行速度は perl のバージョンや実行環境，スクリプト等に影響されるため，必要に応じてベンチマークをとるのがよいでしょう．これまで書いてきた方法は EUC-JP だけではなく，SJIS の場合にも応用することができます．SJIS の場合にも SJIS での 1文字というものを意識して正規表現を書くことになります．SJIS での 1文字については，﹁文字の正規表現﹂を参照．実は，EUC-JP で perl5.005 以降という条件においては，ほとんどの場合にこれまで書いてきた方法よりも実行速度が速く，より扱いやすい方法があります．以下にまとめて列挙します． # EUC-JP で perl5.005 以降限定の方法 $eucpre = qr{(?<!\x8F)}; $eucpost = qr{ (?= (?:[\xA1-\xFE][\xA1-\xFE])* # JIS X 0208 が 0文字以上続いて (?:[\x00-\x7F\x8E\x8F]|\z) # ASCII, SS2, SS3 または終端 ) }x; if ($str =~ /$eucpre(?:$pattern)$eucpost/) { # パターンマッチ print "マッチした\n"; } if ($str =~ /$eucpre\Q$keyword\E$eucpost/) { # キーワードマッチ print "マッチした\n"; } $str =~ s/$eucpre(?:$pattern)$eucpost/$replace/g; # パターン置換 $str =~ s/$eucpre\Q$keyword\E$eucpost/$replace/g; # キーワード置換
いずれの場合においても，$eucpre と $eucpost で挟むだけになります．この方法は正規表現の後読み(lookbehind) と先読み(lookahead) を使っています．後読みは (?<regex)，先読みは (?=regex) という正規表現になります．このスクリプトでは後読みは否定後読みの (?<!regex) の方を使っています．この方法はマッチさせたい正規表現にマッチしたものがずれた位置ではないことを後読みと先読みによって保証しています．具体的には，後読みの部分で JIS X 0212 の 2バイト目からずれてマッチしていないかチェックしています．JIS X 0212 の 2バイト目からマッチしていた場合は，マッチした部分の直前に JIS X 0212 の 1バイト目，すなわち， \x8F があることになります．しかし，後読みによって \x8F ではないことが保証されているので， JIS X 0212 の 2バイト目からずれてマッチすることはなくなります．また，JIS X 0208 の 2バイト目からずれてマッチしてしまう場合と JIS X 0212 の 3バイト目からずれてマッチしてしまう場合についてのチェックは先読み部分で行なっています．もし，このような位置からずれてマッチしてしまった場合，先読み部分にマッチしなくなります．先読み部分はマッチした部分の後ろに正しく EUC-JP の文字列が続いているかどうかをチェックしています．具体的には，マッチした部分の後ろから， JIS X 0208以外のものが来るまで，正しく JIS X 0208 文字が続いているかどうかをチェックしています．この方法では先読みと後読みだけで正しくマッチさせることができます．先読みと後読みはどちらもそれ自体にはマッチした文字列を含まない 0文字幅の正規表現です．したがって，置換する場合に置換後の文字列の中に $eucpre や $eucpost にマッチした部分のことを考えての $1 のようなものを必要としなくなります．トップへ

前後の空白文字(全角スペース含)を削除する

# $str の先頭の空白文字(全角スペース含)を削除する $str =~ s/^(?:\s|$Zspace)+//o; # $str が EUC-JP の場合 $str =~ s/^(?:\s|$Zspace_sjis)+//o; # $str が SJIS の場合 # $str の末尾の空白文字(全角スペース含)を削除する $str =~ s/^($character*?)(?:\s|$Zspace)+$/$1/o; # $str が EUC-JP の場合 $str =~ s/$eucpre(?:\s|$Zspace)+$//o; # $str が EUC-JP の場合(perl5.005以降) $str =~ s/^($character_sjis*?)(?:\s|$Zspace_sjis)+$/$1/o; # $str が SJIS の場合
上記スクリプトで使用している変数については﹁文字の正規表現﹂および﹁正しくパターンマッチさせる﹂を参照してください．前後の全角スペースを含む空白文字を削除するとき，次のように書くと間違って削除してしまう可能性があります．

# $str の末尾の空白文字(全角スペース含)を削除する(間違い)
$str =~ s/(?:\s|$Zspace)+$//o; # $str が EUC-JP の場合
$str =~ s/(?:\s|$Zspace_sjis)+$//o; # $str が SJIS の場合

先頭の空白文字を削除する場合については特に問題ありませんが，末尾の空白文字を削除するときには全角スペースがマルチバイト文字の一部などに間違ってマッチしてしまう可能性があります．例えば，SJIS で $str = '＠＝@'; の場合，間違って末尾を削除してしまいます．詳しくは，﹁perl スクリプトは EUC-JP で書く﹂および﹁正しくパターンマッチさせる﹂を参照してください．トップへ

文字単位に分割する

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $str を文字単位に分割して配列 @chars に代入する $ascii = '[\x00-\x7F]'; $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]'; $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]'; @chars = $str =~ /$ascii|$twoBytes|$threeBytes/og;
最後の代入文をわかりやすく， @chars = ($str =~ /($ascii|$twoBytes|$threeBytes)/og; と書いてもほぼ同等の動作をします．先にそのように書いた場合の説明をします． EUC-JP での 1文字が $ascii|$twoBytes|$threeBytes と正規表現で表わすことができることを﹁正しくパターンマッチさせる﹂で述べました．これを括弧で囲ってグループにしています．一方，この代入文は配列 @chars への代入なので，右辺はリストコンテキストで実行されます．パターンマッチをリストコンテキストで実行すると，グループにされた正規表現にマッチする文字列のリストが返されます．つまり， ($1, $2, $3,…) というリストが返されます．さらに修飾子 gがつけられていますので， ($1, $2, $3,…, $1, $2, $3,…) というリストが返されることになります．この場合はグループにされている正規表現が 1つですので，ちょうど EUC-JP での 1文字に分割されたリストが返されることになります．最初のスクリプトでは @chars への代入文の右辺全体を括弧で囲っていませんが，これは = よりも =~ の方が演算子の優先順位が高いので， @char = $str を先に実行してしまうということはありません．また，正規表現の全体を括弧で囲っていませんが，修飾子 g がつけられているパターンマッチをリストコンテキストで実行したとき，正規表現の中に括弧が 1つもなかった場合は自動的に正規表現全体を括弧で囲ってあるものとして動作します．このとき，正規表現全体を括弧で囲った場合よりも実行速度が速いです．後から $1 として使用するわけでもなく正規表現全体を括弧で囲うような場合には括弧をつけない方がよいでしょう．トップへ

特定の長さで折り返す

# $str を $bytesバイトで折り返す require 'fold.pl'; while (length($str)) { (my $folded, $str) = fold($str, $bytes); print $folded, "\n"; }
fold.pl (歌代和正さん作)を使うのが簡単です．fold.pl を使わず，﹁文字が途切れているか判定する﹂で書いたように文字が途切れていないか判定しながら substr 関数を使って折り返すという方法もありますが，わざわざ書く必要はないでしょう． fold 関数の第3引数に1を指定すれば，折り返した結果 $bytesバイトに満たない場合にはスペースを補って $bytesバイトになるようにすることができます．また，第4引数に1を指定すれば単語境界で折り返すようになります．詳しくは fold.pl の中の説明を読んでください．なお， fold.pl は補助漢字と SJIS の半角カタカナには対応していません．また，EUC-JP の半角カタカナは 2バイト文字として扱いますので，半角カタカナが混じっていると表示幅にずれが発生します．表示幅をそろえたい場合には，半角カタカナをあらかじめ全角カタカナに変換しておくか，折り返すバイト数を適当に処理してあげる必要があります． Jcode.pm の jfold 関数を使っても同じことができますが，単語境界で折り返したりはできません．おまけとして，半角カタカナに対応した禁則処理しつつ折り返すスクリプトを載せておきます．このスクリプトは EUC-JP で書かれ， $str も EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $str を禁則処理しつつ折り返す require 'fold.pl'; require 'jcode.pl'; $no_begin = "!%),.:;?]}￠°’”‰′″℃、。々〉》」』】〕" . "ぁぃぅぇぉっゃゅょゎ゛゜ゝゞァィゥェォッャュョヮヵヶ" . "・ーヽヾ！％），．：；？］｝"; # 行頭禁則文字 $no_begin_jisx0201 = "。」、・ァィゥェォャュョッー゛゜"; jcode::z2h_euc(\$no_begin_jisx0201); $no_begin .= $no_begin_jisx0201; # 行頭禁則文字(半角カタカナ) $no_end = "\$([{￡\‘“〈《「『【〔＄（［｛￥"; # 行末禁則文字 $no_end_jisx0201 = "「"; jcode::z2h_euc(\$no_end_jisx0201); $no_end .= $no_end_jisx0201; # 行末禁則文字(半角カタカナ) $allow_end = $no_begin; # ぶら下げ行頭禁則文字 $del_space = '(?:\s|\xA1\xA1)'; # 削除する行頭行末空白 $basebytes = 74; # 基本長 $maxbytes = 76; # 最大長 $ascii = '[\x00-\x7F]'; $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]'; $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]'; map {$no_begin{$_} = 1;} ($no_begin =~ /$ascii|$twoBytes|$threeBytes/og); map {$no_end{$_} = 1;} ($no_end =~ /$ascii|$twoBytes|$threeBytes/og); map {$allow_end{$_} = 1 + /[\xA1-\xFE]/ - /\x8E/;} ($allow_end =~ /$ascii|$twoBytes|$threeBytes/og); sub fold_properly { my $str = shift; my($folded, $strtmp, $bytestmp, $begin_char, $end_char, $flag); $flag = 1; # 行頭禁則処理状態(1:ぶら下げ, 0:追い出し) $bytestmp = $basebytes; $str =~ tr/\t\n\r\f/ /; # 空白文字をスペースに変換 $str =~ s/^$del_space+//o; # 行頭空白削除 ($begin_char) = %no_begin; # 行頭禁則文字を1文字代入 while ($no_begin{$begin_char} or $no_end{$end_char}) { ($folded, $strtmp) = fold($str, $bytestmp, 0, 1); while (length($folded) - ($folded =~ tr/\x8E//) <= $basebytes and $strtmp ne '' and $flag) { # 半角カタカナのための表示幅処理 ($folded, $strtmp) = fold($str, $bytestmp, 0, 1); my ($folded_tmp, $strtmp_tmp) = fold($str, $bytestmp + 1, 0, 1); if (length($folded_tmp) - ($folded_tmp =~ tr/\x8E//) <= $basebytes) { ($folded, $strtmp) = ($folded_tmp, $strtmp_tmp); $bytestmp++; } else { last; } } ($begin_char) = $strtmp =~ /^$del_space*($ascii|$twoBytes|$threeBytes)/o; ($end_char) = $folded =~ /($threeBytes|$twoBytes|$ascii)$/o; if ($flag) { # ぶら下げ禁則処理 if ($no_begin{$begin_char} and $allow_end{$begin_char}) { # ぶら下げ可能 if (length($folded) - ($folded =~ tr/\x8E//) + $allow_end{$begin_char} <= $maxbytes) { $bytestmp++; } else { $flag = 0; $bytestmp = $basebytes - 1 + ($folded =~ tr/\x8E//); } } else { $flag = 0; $bytestmp--; } } else { $bytestmp--; } if ($bytestmp == 0) { # 禁則処理不可能 ($folded, $strtmp) = fold($str, $basebytes, 0, 1); last; } } $folded =~ s/^((?:$ascii|$twoBytes|$threeBytes)*?(?=$del_space)) $del_space+$/$1/ox; # 行末空白削除 ($folded, $strtmp); } while (length($str)) { (my $folded, $str) = fold_properly($str); print $folded, "\n"; }
トップへ

Base64エンコード・デコードする

$str は EUC-JP という前提ですので，必要ならばあらかじめ EUC-JP に変換しておいてください．漢字コードの変換に関しては﹁漢字コードを EUC-JP に変換して処理する﹂を参照． # $data を Base64エンコードして $encoded_data を求める use MIME::Base64; $encoded_data = encode_base64($data);
Base64エンコードするには，モジュール MIME::Base64 の encode_base64 関数を使います． Base64エンコード・デコードについては RFC 2045( 日本語訳 )に書かれています．これによると Base64エンコードした出力ストリームの各行は 76文字以内でなければならないと書かれています． encode_base64 関数は第2引数を指定しないで呼んだ場合には自動的に 76文字ごとに改行コードを入れて折り返してくれます． # $encoded_data を Base64デコードして元のデータ $data に戻す use MIME::Base64; $data = decode_base64($encoded_data);
Base64デコードするには，モジュール MIME::Base64 の decode_base64 関数を使います． $encoded_data には 76文字ごとに折り返すために挿入されている改行コードが入ったままでもかまいません．次に encoded-word について説明します．encoded-word については RFC 2047( 日本語訳 )に書かれています．encoded-word というのは =?charset?encoding?encoded-text?= という形をしたものです．たとえば =?ISO-2022-JP?B?GyRCTmMbKEI=?= は "例" という文字列を encoded-word にしたものです．ここでは encoding に Bを指定した encoded-word について説明します． encoding が Bというのは encoded-text の部分が Bエンコードされたものであることを表わしています．Bエンコードというのは Base64エンコードと同じエンコード方法ですが， encoded-word の場合は Base64エンコードとは呼ばずに Bエンコードと呼びます． # $str をBエンコードして encoded-word に変換する(不完全) require 'jcode.pl'; use MIME::Base64; jcode::convert(\$str, 'jis', 'euc', 'z'); $str = '=?ISO-2022-JP?B?' . encode_base64($str, '') . '?=';
Bエンコードするには encode_base64 関数を使えばいいのですが，第2引数を指定しない場合はエンコードした結果に改行コードがついてしまうので，空文字列を指定して改行コードがつかないようにしています．また，charset に ISO-2022-JP を指定する都合上，あらかじめ $str を JIS に変換する必要があります．正確には ISO-2022-JP に変換する必要があります．ISO-2022-JP に変換するには基本的に JIS に変換してあげればいいのですが， ISO-2022-JP では半角カタカナを使うことができません．そこで半角カタカナが含まれていた場合には全角カタカナに変換する必要があります．これをやるには jcode::convert 関数の第4引数に 'z' を指定してあげます． encoded-word に変換する基礎はこれだけなのですが，これはあくまでも基礎であって RFC 2047 を満たすことができない不完全なものです． RFC 2047 には encoded-word に変換する上で守らなければならない決まりについて．だいたい次のようなことが書かれています． (一)encoded-word は 75バイト以内でなければならない． (二)encoded-word を含む行は 76バイト以内でなければならない． (三)encoded-word はそれぞれ独立してデコード可能でなければならない． (四)encoded-text をデコードした文字列の文字コードは，最後に ASCII が指定された状態でなければならない． (五)encoded-word が現れる出現位置に関する決まり． ●Subject や Comment のヘッダフィールドなどの， 'text' 内に出現． ●"(" と ")" で区切られた 'comment' 内に出現． ●From やTo，CCヘッダなどで，'phrase' 内に出現． ●'addr-spec' 内で出現してはならない． ●'quoted-string' 内で出現してはならない．などなど． (六)隣り合う encoded-word の間の 'linear-white-space' は無視する． 1から4までが encoded-word に変換するときに関係してきます．さきほどのスクリプトでは3と4についてはクリアしていますが，1と2については全然気にしていません．1と2についても対応するためには少々困った問題が起きます．まず，1についてですが，encoded-word の長さが 75バイトを超えるような場合には，Bエンコードする対象を短くして，2つ以上の encoded-word に分けて変換しなければなりません．2つ以上の encoded-word に分けるために，Bエンコードした後の encoded-text を3が満たされるようにうまく分割することもできますが，それでは4を満たすことができなくなってしまいます．4を満たしつつ対象を短くするには，適当なところで対象の文字列を分割しては駄目で，ちゃんと日本語の文字単位で短くしなければなりません．つまり，漢字などの 2バイト文字や 3バイト文字の途中で分割しては駄目だということです．日本語の文字単位で短くすることができたら，後は jcode.pl を使って JIS に変換すれば，自動的に最後の文字コードが ASCII の状態になるようにしてくれます．次に，2についての困った問題というのを説明します．encoded-word を含む行が 76バイト以内でなければならないということは， encoded-word に変換するときに，変換した後の行が 76バイト以内になっているように encoded-word の長さを調整しなければならないということになります．もし， encoded-word に変換するとその行が 76バイトを超えてしまう場合には，改行して折り返す必要があります．以上が encoded-word への変換そのものについての少々困った問題ということになるのですが，実はそれ以前に一番困った問題というのがありまして，それが5です．つまり，どの部分を encoded-word に変換すればいいのか，ということが一番問題なのです．同様に，どの部分をデコードしたらいいのかというのも問題になります．文字列を与えられてうまく処理しろと言われたら字句解析や構文解析が必要になってしまいます．ここではとてもそこまではできませんので，encoded-word に変換したい部分，逆変換したい部分を与えられた場合のスクリプトを書きます． # $str を encoded-word に変換し $line に追加する require 'jcode.pl'; use MIME::Base64; $ascii = '[\x00-\x7F]'; $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]'; $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]'; sub add_encoded_word { my($str, $line) = @_; my $result; while (length($str)) { my $target = $str; $str = ''; if (length($line) + 22 + ($target =~ /^(?:$twoBytes|$threeBytes)/o) * 8 >76) { $line =~ s/[ \t\n\r]*$/\n/; $result .= $line; $line = ' '; } while (1) { my $encoded = '=?ISO-2022-JP?B?' . encode_base64(jcode::jis($target, 'euc', 'z'), '') . '?='; if (length($encoded) + length($line) >76) { $target =~ s/($threeBytes|$twoBytes|$ascii)$//o; $str = $1 . $str; } else { $line .= $encoded; last; } } } $result . $line; } $line = add_encoded_word($str, $line);

実行例
$line = 'Subject: ';
$str = 'これはテストです．This is test.';
$line = add_encoded_word($str, $line);
print $line, "\n";

実行結果
Subject: =?ISO-2022-JP?B?GyRCJDMkbCRPJUYlOSVIJEckOSElGyhCVGhpcyBpcyB0ZXN0?=
 =?ISO-2022-JP?B?Lg==?=

このスクリプトは $line に $str を encoded-word に変換してから追加します． $str がかなり長い場合は，encoded-word が速く 75バイト以内になるように当たりをつけてからやった方がいいのですがこのスクリプトでは行なっていません．また，どの部分を encoded-word にするかですが，RFC 2047 には本来 encoded-word に変換する必要のないもの，つまり，ASCII だけから成る単語まで変換するのは推奨できないと書かれています．ですから，実行例のように is や test. までいっしょに encoded-word に変換するのはあまりいい例とは言えません．これについては，Subject などの unstructured header の場合に対応したスクリプトを次に書きます． # unstructured header $header を MIMEエンコードする # add_encoded_word() については上のスクリプトを参照 sub mime_unstructured_header { my $oldheader = shift; my($header, @words, @wordstmp, $i) = (''); my $crlf = $oldheader =~ /\n$/; $oldheader =~ s/\s+$//; @wordstmp = split /\s+/, $oldheader; for ($i = 0; $i < $#wordstmp; $i++) { if ($wordstmp[$i] !~ /^[\x21-\x7E]+$/ and $wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/) { $wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]"; } else { push(@words, $wordstmp[$i]); } } push(@words, $wordstmp[-1]); foreach $word (@words) { if ($word =~ /^[\x21-\x7E]+$/) { $header =~ /(?:.*\n)*(.*)/; if (length($1) + length($word) >76) { $header .= "\n $word"; } else { $header .= $word; } } else { $header = add_encoded_word($word, $header); } $header =~ /(?:.*\n)*(.*)/; if (length($1) == 76) { $header .= "\n "; } else { $header .= ' '; } } $header =~ s/\n? $//mg; $crlf ? "$header\n" : $header; } $header = mime_unstructured_header($header);

実行例
$header = "Subject: ASCII 日本語 ASCIIと日本語 ASCII ASCII\n";
$header = mime_unstructured_header($header);
print $header;

実行結果
Subject: ASCII =?ISO-2022-JP?B?GyRCRnxLXDhsGyhCIEFTQ0lJGyRCJEhGfEtcGyhC?=
 =?ISO-2022-JP?B?GyRCOGwbKEI=?= ASCII ASCII

このスクリプトは前述のスクリプトの関数 add_encoded_word() を利用しています．前述のスクリプトの最後の $line = add_encoded_word($str, $line); を削除し，このスクリプトに変更して使います．このスクリプトの前半部分で単語ごとに分割しています．ここで分割された単語ごとに，ASCII だけから成る単語かどうかを判定して encoded-word に変換するかどうかを決定していきます．このとき6に注意する必要があります．デコードのときに encoded-word の間の 'linear-white-space' は無視されるのですが，これは 1行の長さが長くなってしまう場合に，encoded-word を分割するために挿入された本来不必要な 'linear-white-space' を削除するためのものです．しかし，元から存在する 'linear-white-space' の両側を encoded-word に変換してしまうと，デコードのときに間違って削除されてしまうことになります．そこで，'linear-white-space' の両側を encoded-word に変換する必要がある場合には，'linear-white-space' を含めた両側の単語を 1つの encoded-word として変換します． # $str をBデコードして encoded-word を元に戻す require 'jcode.pl'; use MIME::Base64; $lws = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+'; $ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?='; $str =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio; $str =~ s/$lws/ /go; $str =~ s/$ew_regex/decode_base64($1)/egio; jcode::convert(\$str, 'euc', 'jis');
このスクリプトは与えられた文字列 $str の中の encoded-word を元に戻します．隣り合う encoded-word の間の 'linear-white-space' は無視します．encoded-word は "(" の直後であるとか，'linear-white-space' の直後であるような場合に encoded-word であって，そうでない場合は一見 encoded-word に見えても，偶然そういう文字列であると解釈し，勝手に元に戻そうとすべきではありません．しかし，このスクリプトでは encoded-word に見えたものはすべて元に戻してしまいますので，文字列 $str を与える方でその判定を行ない，元に戻しても問題ないものだけを与える必要があります．たとえば， $str = q{"=?ISO-2022-JP?B?GyRCTmMbKEI=?="}; のときは quoted-string であるので，この中に encoded-word が現れるはずがありません．これを勝手に元に戻そうとしてはいけません．古い Outlook Express などは encoded-word に変換したものをダブルクォートで囲んで quoted-string にするので，RFC 2047 を満たすことができません．Outlook Express 5 ではこの点は修正されたようです．しかし，Outlook Express 5 を含むほとんどのメーラーは encoded-word を含む行が 76バイト以内でなければならないという制約を満たしていません． encoded-word への変換を行なうスクリプトとして， mime_pls(mimew.pl) (生田昇さん作)というものも公開されています．しかし，これも RFC 2047 を完全に満たしているわけではありません． encoded-word への変換に関しては， Subject 行や From 行の違いを考慮せずに同じコメント処理をしてしまいます．また，word単位で行なっていないので，たとえば $str = "testテスト"; のような文字列を変換，逆変換を行なうと "test テスト" のように余分なスペースが入ってしまいます．特殊変数 $`， $&， $' を使用しているので，すべてのパターンマッチの速度が少し遅くなってしまう点は改良の余地があります． encoded-word からの逆変換に関しては，さきほど述べたように一見 encoded-word に見えるものまで元に戻してしまいます．これを正しく行なうためにはどうしても構文解析が必要になります． Jcode.pm の MIMEエンコード関数 mime_encode と MIMEデコード関数 mime_decode はバージョン 0.63以降で上記のスクリプトが採用されています． RFC 2047 を完全に満たしている encoded-word への変換を行なうスクリプトとしては IM(Internet Message) の IM::Iso2022jp モジュールがあります．標準モジュールではないので，使うためにはIMをインストールする必要があります．使い方は Iso2022jp.pm の中身を見てください．トップへ

URIエスケープ・アンエスケープする

'エスケープ' という文字列を '%a5%a8%a5%b9%a5%b1%a1%bc%a5%d7' のように URIエスケープするには次のように書きます． # $str を URIエスケープする $str =~ s/(\W)/'%' . unpack('H2', $1)/eg;
逆に '%a5%a8%a5%b9%a5%b1%a1%bc%a5%d7' という文字列を URIアンエスケープして 'エスケープ' という文字列に戻すには次のように書きます． # $str を URIアンエスケープする $str =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
私がベンチマークをとって調べた限りでは，上記のように URIエスケープ・アンエスケープする方法が一番実行速度が速いでしょう．これ以外の方法としては unpack 関数を使わずに sprintf 関数と ord 関数を使うとか， pack 関数をフォーマット 'H2' で使わずに hex 関数と chr 関数，あるいは， hex 関数と pack 関数をフォーマット 'C' で使うとか，修飾子 iを使うとか， {2} を使うとかいろいろありますが，特に書く必要はないでしょう．また，'%A5%A8%A5%B9%A5%B1%A1%BC%A5%D7' のようにアルファベットを大文字に変換してもいいのですが，その場合は sprintf 関数と ord 関数を使った方法となり，処理が遅くなります．また，ハッシュと演算子 ||= を使って，次のように計算結果を再利用する方法がありますが，CGI などで使う程度ではほとんどの場合上記のスクリプトより遅いでしょう．

# $str を URIエスケープする(再利用版)

$str =~ s/(\W)/$escape{$1} ||= '%' . unpack('H2', $1)/eg;

# $str を URIアンエスケープする(再利用版)

$str =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/$unescape{$1} ||= pack('H2', $1)/eg;

再利用版が遅い理由は，再利用しようとする計算部分，つまり， '%' . unpack('H2', $1) や pack('H2', $1) がそれほど遅い処理ではないからです．この部分が遅い処理である場合には，一度計算した結果を数回再利用することで十分に効果が出ますが，今回の場合のようにそれほど遅い処理ではない場合には，ハッシュを使用したり ||= による演算のオーバーヘッドのために逆に遅くなってしまいます．私がベンチマークをとって調べたところ， URIアンエスケープの再利用版では再利用率700%ぐらい，つまり，一度計算したすべての結果を 7回再利用したころからようやく効果が出始めるという程度でした．逆に言えば，大量の文章を処理しようとした場合には効果があるということなのですが，そのような場合は次のようにあらかじめ変換テーブルを用意しておく方が実行速度が速いです． # $str を URIエスケープする(変換テーブル版) foreach $i (0x00 .. 0xFF) { $escape{chr($i)} = sprintf('%%%02x', $i); } $str =~ s/(\W)/$escape{$1}/g;
# $str を URIアンエスケープする(変換テーブル版) foreach $i (0x00 .. 0xFF) { $unescape{sprintf('%02x', $i)} = chr($i); $unescape{sprintf('%02X', $i)} = chr($i); } $str =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/$unescape{$1}/g;
変換テーブル版では最初に変換テーブルを用意するという前処理が必要になりますが，変換そのものは修飾子 e がなくなり，文字列展開のみになるので最も実行速度が速いです． URIエスケープの対象となる文字ですが，上記のスクリプトでは単純に \W としていました．しかし，これは厳密にはURIエスケープの必要がない文字までも URIエスケープしてしまいます．必ずURIエスケープしなければならない文字は RFC 2396( 日本語訳 )で unreserved として定義されている文字以外になります． unreserved 以外の文字だけをURIエスケープするスクリプトは以下のようになります． # $str を URIエスケープする(必要最小限版) $str =~ s/([^a-zA-Z0-9_.!~*'()-])/'%' . unpack('H2', $1)/eg;
ここから先は CGI や URI 特有の話になります． URIエスケープするには，﹁RFC 2396で URI文字として使用できる文字 uric として定義されているもの以外をエスケープすればいいので，モジュール URI::Escape の uri_escape 関数を使って，正規表現 [;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()] で表わされる文字以外をエスケープすればいい﹂という話がありますが，これは間違いです．正確には，ある意味ではそれでいいのですが，おそらく CGI を書く人にとってはほとんどの場合間違いでしょう．uri_escape 関数がやろうとしているのは， URI を入力としたときに URI文字以外の文字をエスケープすることであって，CGI を書く人がなんらかの値をエスケープしようとすることとは意味が違います．たとえば， $value = 'A&B=C'; のとき， print "http://foo.bar/cgi-bin/hoge.cgi?value=$value"; とすることを考えたらどうなると思いますか？ uri_escape 関数を使って $value をエスケープしても & や = は URI文字なのでエスケープはされません．この結果， value=A と B=C という 2つを & でつなげていると解釈されてしまいます．実は uri_escape 関数は第2引数で変換対象とする文字を与えることができます．ただ，やっている内容は上に書いたスクリプトと同じことなので，わざわざ標準ではないモジュール URI::Escape をインストールして使うこともないでしょう．次に，スペースと + の相互変換の話をします．CGI に何らかのデータを渡す方法としては，FORM の GET または POST を使う方法とコマンドライン引数として渡す方法の 2つがあります．この 2つ方法ではそれぞれスペースと + の相互変換の話が違っています．FORM の GET または POST を使う方法については HTML 4.0( 日本語訳 ) の 17.13.4 Form content types に content types がデフォルトの application/x-www-form-urlencoded のときのエンコード方法として書かれています．コマンドライン引数として渡す方法については CGI/1.1の 5. The CGI Script Command Line に書かれています． application/x-www-form-urlencoded でのエンコードでは control names と values のスペースは + に変換し，それ以外の予約文字を %HH の形式に URIエスケープします．そして，controle names と values を = で区切った組とし，その組を & で区切って並べます．つまり，スペースは + に変換し，それ以外の予約文字を URIエスケープした上で， name1=value1&name2=value2 というような形式にすることです． control names や values に対して行なう文字処理部分は次のようになります． # $str に対しエンコードの文字処理部分を行なう $str =~ s/([^\w ])/'%' . unpack('H2', $1)/eg; $str =~ tr/ /+/;
スペースは + に変換しなければならないので， URIエスケープした後で s/%20/+/g; と再度変換しなおす方法もありますが，このスクリプトのようにスペースに対して余計な処理を行なわないようにした方が実行速度が速いです． # $str に対しデコードの文字処理部分を行なう $str =~ tr/+/ /; $str =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
先に URIアンエスケープしてしまうと，+ に変換されているスペースと区別がつかなくなるので，その前に + をスペースに戻しておきます．このとき $str =~ s/\+/ /g; としても可能ですが，文字単位の変換なので実行速度が速い tr 関数を使います．世間一般で使用されている URLエンコードというのが何を指しているのか私にはよくわからないのですが， application/x-www-form-urlencoded でのエンコードのことを URLエンコードと言うのであれば，予約文字を %HH の形式に変換する URIエスケープの処理だけを指して URLエンコードと言うのは間違いになります．もし，URIエスケープのことを URLエンコードと言うのであれば，スペースを + に変換しなければならないというのは間違いになります．一方，コマンドライン引数として渡す方法ですが，この方法の書式は search-string = search-word *( "+" search-word ) となっています．具体的な例で言いますと， http://foo.bar/cgi-bin/hoge.cgi?arg1+arg2+arg3 のようになります．このときスペースを + に変換するという話はどこにもありません．search-string 同士を区切っている + は最初から + であって，スペースを変換したものではないのです．もし，search-string にスペースが含まれていた場合には，その他の予約文字と同様 URIエスケープされることになるので %20 に変換されることになります．スペースを間違って + に変換してしまうと，たとえば $value = 'A B C'; のとき，これを CGI の引数として渡そうと print "http://foo.bar/cgi-bin/hoge.cgi?$value"; とすることを考えたら， http://foo.bar/cgi-bin/hoge.cgi?A+B+C となり，このとき hoge.cgi は 3つの引数 'A'，'B'， 'C' を受け取ることになってしまいます．これは http://foo.bar/cgi-bin/hoge.cgi?A%20B%20C とするのが正解になります．コマンドライン引数として渡す方法ではスペースが + に変換されているわけではないので，受け取った側で + をスペースに戻すようなことをしてはいけないということになります．コマンドライン引数として渡す方法でも QUERY_STRING から query 部分，つまり， ? 以降の部分を取得することができます．もし， FORM の GET または POST を使う方法とコマンドライン引数として渡す方法のどちらでデータが渡されるのかわからない場合に， QUERY_STRING からデータをもらって処理するためには， + をスペースに変換すべきか変換すべきではないのか判断する必要があります．判断する方法は簡単で，QUERY_STRING に = が含まれているかどうかを調べます．もし含まれていれば，それは application/x-www-form-urlencoded でのエンコードをされていることになります．含まれていなければ，コマンドライン引数としてデータが渡されたことになります．トップへ

改行コードを統一する

s/\x0D\x0A|\x0D|\x0A/\n/g;
このスクリプトは Windows(DOS)，Mac，UNIX のいずれかのプラットフォームの改行コードを自プラットフォームの改行コードに統一します．改行コードは Windows(DOS)では \x0D\x0A， Macでは \x0D，UNIX では \x0A なので，これらすべての改行コードに対応するには \x0D\x0A|\x0D|\x0A とする必要があります．このとき順番は \x0D\x0A を必ず最初にしなければなりません．改行コードを統一するために s/\r\n|\r/\n/g; と書くのは間違いです．このように書いて正常に動作するのは Windows(DOS) と UNIX の perl のみで，Mac の perl では正常に動作しません．よく﹁改行コードは Windows(DOS) では \r\n，Mac では \r，UNIX では \n である﹂という人がいますが，これはある意味正しいと言えなくもないのですが，根本的には間違っています．以降で何がどう間違っているのか説明しますが，その前に実際の値としての改行コード値と論理的な改行文字が別物であるということを頭の片隅にとどめておいてください．まず，実際の値としての改行コード値が Windows(DOS)では \x0D\x0A，Macでは \x0D， UNIX では \x0A であるということは特に問題ないでしょう．それでは \r や \n というのは一体何なのでしょうか？答えはそれぞれ Perl という言語の中で論理的に定義された復帰文字と改行文字です．プラットフォームによって改行コード値は \x0D\x0A であったり，\x0D や \x0A であったりするわけですが，改行するためにはどのプラットフォームであろうと Perl という言語では論理的な改行文字である \n を出力することになります．つまり，﹁改行は Windows(DOS) でも Mac でも UNIX でも \n﹂なのです．それでは \r と \n が実際にどのようなコード値になっているのかまとめたものが以下の表になります (Macは推測．間違いはご指摘ください)．

	Windows(DOS)	Mac	UNIX
改行コード値	`\x0D\x0A`	`\x0D`	`\x0A`
改行文字	`\n`	`\n`	`\n`
復帰文字	`\r`	`\r`	`\r`
`print FH "\n";`	`\x0D\x0A` を出力	`\x0D` を出力	`\x0A` を出力
`print FH "\r";`	`\x0D` を出力	`\x0A` を出力	`\x0D` を出力
`binmode FH; print FH "\n";`	`\x0A` を出力	`\x0D` を出力	`\x0A` を出力
`print FH "\r\n";`	`\x0D\x0D\x0A` を出力	`\x0A\x0D` を出力	`\x0D\x0A` を出力
`binmode FH; print FH "\r\n";`	`\x0D\x0A` を出力	`\x0A\x0D` を出力	`\x0D\x0A` を出力

自プラットフォームの改行コード値だけを対象にしているのならば，たとえば， UNIX の perl ならば \x0D は \r であり， \x0A は \n であるとすることができます．ただし，その場合でもテキスト処理するときに限られます．何らかのバイナリファイル内の \x0A が改行を意味するわけではないからです．当然，改行コードを統一するスクリプトというように，自プラットフォーム以外の改行コード値のことも考えて処理する場合には勝手に \x0D は \r で， \x0A は \n だと決めつけてはいけません．\r や \n はあくまでも論理的な文字なのです．最初のスクリプトは，Windows(DOS)，Mac，UNIX での実際の改行コード値を論理的な改行文字に置換しているという意味になります．最初のスクリプトは簡潔でわかりやすく書かれてはいますが，実行速度は遅いです．次のように trを使って 2文でやった方が圧倒的に速いです． s/\x0D\x0A/\n/g; tr/\x0D\x0A/\n\n/;
なお，Perl内部では Windows(DOS) でも Mac でも UNIX でも， \r は \x0D か \x0A のどちらかであり， \n はその逆であるという特性を利用することで，次のように書くことが可能です． s/\x0D\x0A/\n/g; tr/\r/\n/; # 意味的には tr/\x0D\x0A/\n\n/;
このスクリプトの方が，tr で変換が行なわれなかった場合において，わずかに実行速度が速くなります．ただし，これまで述べてきたように意味的には間違った書き方であることを十分理解した上で使う必要があります．トップへ

改行コードを に変換する

s/\x0D\x0A|\x0D|\x0A/ /g;
改行コードは Windows(DOS)では \x0D\x0A， Macでは \x0D， UNIX では \x0A なので，これらすべての改行コードに対応するには \x0D\x0A|\x0D|\x0A とする必要があります．このとき順番は \x0D\x0A を必ず最初にしなければなりません．このスクリプトは簡潔でわかりやすく書かれてはいますが，実行速度は遅いです． s/\x0D\x0A|[\x0D\x0A]/ /g; とするとほんの少し速くなりますが，ほとんどの場合次のように 3文でやった方が圧倒的に速いです． s/\x0D\x0A/ /g; s/\x0D/ /g; s/\x0A/ /g;
改行について詳しくは﹁改行コードを統一する﹂を参照．トップへ

改行コードを削除する

tr/\x0D\x0A//d;
﹁改行コードを に変換する﹂と同じ手法で， s/\x0D\x0A|\x0D|\x0A//g; と書いても改行コードを削除することができます．また， に変換する場合と違って， \x0D，\x0A という 2つの文字を両方とも削除すればいいので， s/[\x0D\x0A]//g; と書いても同じことができます．しかし，このように文字単位で変換する場合は， tr/\x0D\x0A//d; と書いた方が s/\x0D\x0A|\x0D|\x0A//g; や s/[\x0D\x0A]//g; とするよりも実行速度が速いので， tr を使って改行コードを削除するようにするのがいいでしょう．ここで注意が必要なのは，この方法で改行コードを削除すると，文字列の中に含まれるすべての改行コードが削除されるということです．1行入力された場合のように，文字列の最後にだけ改行コードがあるとわかっているときは， chomp を使います．ただし， chomp は Windows(DOS) や Mac，UNIX といった処理系に依存します． \x0D\x0A を UNIX の perl で chomp した場合は， \x0D が残ってしまいます．もし，複数の処理系の改行コードを想定しなければならない場合は，次のようにして文字列の最後の改行を削除します． s/\x0D?\x0A?$//;
改行について詳しくは﹁改行コードを統一する﹂を参照．トップへ

CSV形式の行から値のリストを取り出す

# CSV形式の $line から値を取り出して @values に入れる { my $tmp = $line; $tmp =~ s/(?:\x0D\x0A|[\x0D\x0A])?$/,/; @values = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g); }
CSV(Comma Separated Value)形式というのは，完全にアプリケーションに依存した形式であるので，このスクリプトであらゆるアプリケーションが扱う CSV形式の行から値を取り出せるわけではありません．このスクリプトはもっとも需要があると思われ，また，比較的一般的な定義である Excel が出力する CSV形式について扱うこととしました．Excel が出力する CSV形式がどのようなものか Excel のヘルプに載っていませんでしたが，私が独自に調べた結果以下のようなものであるとしました． (一)基本的にコンマで区切った部分がスペースを含めて値である． (二)値にコンマやダブルクウォートが含まれる場合は，値全体をダブルクウォートで囲む． (三)値に含まれるダブルクウォートは "" となる．このスクリプトでは，まずはじめに $line のコピーを $tmp に取ってから処理しています．コピーを取らずに処理すると，次の処理で $line を変更してしまうことになるためです．具体的には，抽出処理を簡単にするために，最後の値の後ろにコンマをつけ加えています．このとき $line の最後に改行コードがついていた場合を考え，改行コードの削除も同時に行なっています．ここまでの処理で $line の中身は値,値,値, というように値, の繰り返しになっています．次に値,値,値, という形から個々の値を取り出すわけですが，これを行なうために修飾子 gをつけたパターンマッチを行ないます．修飾子 gをつけたパターンマッチをリストコンテキストで実行すると， ()によるグループにマッチした部分文字列のリストを返します．値の部分にマッチする正規表現をグループにしておけば，値のリストを取り出すことができるわけです．ここで注意が必要なのは，値, となっているものと， "値", となっているものの 2種類があることです．そして，"値", の形の方の値にはコンマが含まれている可能性があります．したがって，単純に split /,/, $tmp や ($tmp =~ /([^,]*),/g) のようにしてしまうと，値の中のコンマによって値が 2つに別れてしまうことになります．そこでまずは値を区切っているコンマで値と "値" を正確に取り出すことを考えます．値, の形の値にはコンマが含まれていませんから，値の部分にマッチさせるには /([^,]*),/ とすればいいことになります．一方，"値", の形の "値" の部分にマッチさせるには，/("[^"]*"),/ とすればいいように思うかもしれませんが，CSV形式の 3番目の定義により，値には "" というのが含まれている可能性があります．そこで， [^"] 以外に "" の場合も考え， /("(?:[^"]|"")*"),/ とすればいいことになります．この 2つの形を合成して， ($tmp =~ /("(?:[^"]|"")*"|[^,]*),/g) となります．これで値または "値" のリストとして取り出すことができます．ただ，正規表現の部分はこのままでもいいのですが，スクリプトではさらにこの正規表現を Jeffrey E. F. Friedl氏原著による﹁詳説正規表現﹂で﹁ループ展開﹂として書かれている手法で変形し実行速度を速くしてあります．最後に "値" から値を復元する必要があります．値の形ならそのまま，"値" の形ならば両側のダブルクウォートを取り除き，さらに "" は " に変換します．この処理を map 関数の中で行なっています．これでCSV形式の行から値を取り出すことができます．モジュール Text::CSV を使えば同じようなことができますが，ASCII しか扱えないので日本語が含まれる場合には使えません．モジュール Text::CSV_XS をバイナリモードで使えば日本語を扱うことができます．ただし，どちらのモジュールも標準ではないためアーカイブファイルを取ってきてインストールする必要があります．トップへ

値に改行コードを含む CSV形式を扱う

# 値に改行コードを含む CSV形式を扱う while (my $line = <DATA>) { $line .= <DATA> while ($line =~ tr/"// % 2 and !eof(DATA)); $line =~ s/(?:\x0D\x0A|[\x0D\x0A])?$/,/; @values = map {/^"(.*)"$/s ? scalar($_ = $1, s/""/"/g, $_) : $_} ($line =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g); # @values を処理する }
値に改行コードを含む CSV形式は﹁CSV形式の行から値のリストを取り出す﹂で書いた Excel が出力する CSV形式を以下のように修正したものであるとしました． (一)基本的にコンマで区切った部分がスペースを含めて値である． (二)値にコンマやダブルクウォート，改行コードが含まれる場合は，値全体をダブルクウォートで囲む． (三)値に含まれるダブルクウォートは "" となる． CSV形式の 1行に現れるダブルクウォートは， "値" のように値を囲む場合と，値に含まれていたダブルクウォートが "" となっている場合です．したがって，CSV形式の 1行には，ダブルクウォートが必ず偶数個あることになります．もし，ダブルクウォートが奇数個だった場合には，値に含まれる改行コードによって，もともと 1行の CSV形式だった行が複数行に別れてしまっていることになります．そこでダブルクウォートの数を数え，奇数個だった場合には次の行を追加します．これをダブルクウォートが偶数個になるまで繰り返します． tr/"// でダブルクウォートの数を数えています．こうして正しく CSV形式の 1行を取り出すことができたら，あとは﹁CSV形式の行から値のリストを取り出す﹂とほとんど同じスクリプトで処理することができます．唯一の違いは map 関数の中でのパターンマッチで，修飾子 s をつけていることです．修飾子 sをつけることによって，ピリオドが改行コードにもマッチするようになります．トップへ

値のリストから CSV形式に変換する

# 値の配列 @values から CSV形式の行 $line に変換する $line = join ',', map {(s/"/""/g or /[\r\n,]/) ? qq("$_") : $_} @values;
このスクリプトは，値の配列から﹁CSV形式の行から値のリストを取り出す﹂や﹁値に改行コードを含む CSV形式を扱う﹂で定義した CSV形式の行に変換するものです．値をコンマで区切って結合させる前に，ダブルクウォート・改行コード・コンマのいずれかが含まれる値については， "値" の形に変換する必要があります．また，ダブルクウォートについては，"" に変換しておく必要があります．これを map 関数によって一度に行なってしまっています． s/// は置換を行ない，その回数を返します．したがって， s/"/""/g というのは，ダブルクウォートがあればそれを "" に置換し，置換した回数，つまりこの場合は値に含まれていたダブルクウォートの個数を返すことになります．この個数が1以上，または改行コードかコンマが含まれていた場合に "値" の形に変換しています．このスクリプトによって得られる $line には最後に改行コードが含まれていませんので，ファイルなどに書き出すときには次のように改行コードをつける必要があります．

print $line, "\n";

トップへ

特定の項目でソートする

ここでは以下のようなデータに対するソートを例に説明します．1つ 1つの要素は第1～3項をコンマで区切った形式をしています．

@data = ('A,7,緑',
         'C,6,青',
         'B,4,赤',
         'A,9,紫',
         'A,2,黄緑',
         'B,10,黄',
         'C,3,青紫');

# 第2項でソートする @data = map {$_->[0]} sort {$a->[2] <=> $b->[2]} map {[$_, split /,/]} @data;

ソート後のデータ
@data = ('A,2,黄緑',
         'C,3,青紫',
         'B,4,赤',
         'C,6,青',
         'A,7,緑',
         'A,9,紫',
         'B,10,黄');

この方法は Schwartzian Transform と呼ばれている方法です．このスクリプトはデータを要素の第2項の数字の部分でソートしています．ソートを行なうには sort 関数を使えばいいのですが，もとの要素のままではアルファベット，数字，色がコンマで区切られた 1つの文字列になってしまっているので，数字の部分だけでソートすることができません．そこで，要素から数字の部分を抜き出してソートする必要があります．要素から数字の部分を抜き出してソートするには次のように書けばできます．

@data = sort {
  my ($alpha_a, $num_a, $color_a) = split(/,/, $a);
  my ($alpha_b, $num_b, $color_b) = split(/,/, $b);
  $num_a <=> $num_b;
} @data;

しかし，この方法は非常に効率が悪いものです．なぜならば，比較が行なわれるたびに要素を分解しているからです．そこで，あらかじめ要素を分解しておき，比較するときに余計な処理をさせないことが重要となります．要素を分解，比較，もとの要素に戻すということを一度に効率的にやってしまうのが Schwartzian Transform です．最初のスクリプトに戻って説明します．ソートは 3行に渡って書かれていますが，これで 1文です．実際の実行は 3行目， 2行目， 1行目の順番で行なわれます．それぞれ，要素を分解，比較，もとの要素に戻すということをやっています．まず，3行目でデータの 1つ 1つの要素に対して，無名配列へのリファレンスを作って，これを要素とする新たな配列に変換しています．新しい要素は [$_, split /,/] です．これは簡単に言ってしまえば， (もとの要素, 第1項, 第2項, 第3項) という配列だと思えばいいでしょう．次に，2行目で実際にソートします． $a->[2] や $b->[2] は，3行目であらかじめ分解して新しい要素に変換した無名配列の添え字2の要素，つまり，第2項を表わしています．ここでは要素を取り出しているだけなので，毎回分解していたやり方に比べて効率がよいことがわかると思います．最後に 1行目でもとの要素に戻しています． Schwartzian Transform には，毎回分解していたやり方に比べて効率がよい，無名配列を使うことによって中間データを保持するため作業用の配列を特別に用意する必要がない，すべての処理を簡潔に記述することができるといった特徴があります．しかし，無名配列を使用しているために，無名配列から要素を取り出すというオーバーヘッドが生じてしまいます．このため，次のように作業用の配列を用意して行なう方法の方が実行速度が速いです． # 第2項でソートする(作業用配列を使った高速版) @tmp = map {(split /,/)[1]} @data; @data = @data[sort {$tmp[$a] <=> $tmp[$b]} 0 .. $#tmp];
このスクリプトは，最初に作業用配列 @tmp に第2項を取り出しておき，配列の添え字のリスト値 0 .. $#tmp に対してソートを行ない，ソートされた添え字をもとに配列スライスで @data からリスト値を取り出すことでソートしています．トップへ

複数の項目でソートする

ここでは以下のようなデータに対するソートを例に説明します．1つ 1つの要素は第1～3項をコンマで区切った形式をしています．

@data = ('A,7,緑',
         'C,6,青',
         'B,4,赤',
         'A,9,紫',
         'A,2,黄緑',
         'B,10,黄',
         'C,3,青紫');

# 第1項でソートし，さらに第2項で降順ソートする @data = map {$_->[0]} sort {$a->[1] cmp $b->[1] or $b->[2] <=> $a->[2]} map {[$_, split /,/]} @data;

ソート後のデータ
@data = ('A,9,紫',
         'A,7,緑',
         'A,2,黄緑',
         'B,10,黄',
         'B,4,赤',
         'C,6,青',
         'C,3,青紫');

このスクリプトは，まず第1項のアルファベットでソートし，同じアルファベットの中ではさらに第2項の数字を比較して降順になるようにソートしています．基本的な動作は﹁特定の項目でソートする﹂で説明した内容と同じです．違いは 2行目の sort 関数の中だけです．複数の項目でソートしたい場合は，このようにソート条件を or を使って並べてやるだけです．第1項のアルファベットでソートするときは文字列の比較になりますので cmp を使います．第2項は数字の比較になりますので <=> を使います．また，第2項は降順でソートしたいので， $a と $b を左右逆にしなければなりません．上のスクリプトを作業用配列を使って実行速度が速くなるようにしたものが次のスクリプトになります． # 第1項でソートし，さらに第2項で降順ソートする(作業用配列を使った高速版) @tmp1 = @tmp2 = (); foreach (@data) { my ($first, $second) = split /,/; push(@tmp1, $first); push(@tmp2, $second); } @data = @data[sort {$tmp1[$a] cmp $tmp1[$b] or $tmp2[$b] <=> $tmp2[$a]} 0 .. $#tmp1];
このスクリプトの基本的な動作は﹁特定の項目でソートする﹂で説明した内容と同じです．簡潔に記述したいのであれば Schwartzian Transform ですが，実行速度を速くしたいのであれば簡潔に記述することをあきらめるしかないようです．おまけとして，数字で始まる文字列を含まない任意の項目数のデータを昇順で多重ソートするスクリプトを載せておきます．このスクリプトは perl5.005 以降でしか動作しませんが， expr foreach () の形を foreach () {expr} の形にすれば， perl5.005 以前の perl5 でも動作するようになります． # 任意の項目数のデータを昇順で多重ソートする @data = map {$_->[0]} sort {$x = ($a->[$_] <=> $b->[$_] or $a->[$_] cmp $b->[$_]) and return $x foreach (1 .. $#$a); -1} map {[$_, split /,/]} @data;
トップへ

自分で決めた順番でソートする

ここでは以下のようなデータに対するソートを例に説明します．1つ 1つの要素は第1～3項をコンマで区切った形式をしています．

@data = ('A,7,緑',
         'C,6,青',
         'B,4,赤',
         'A,9,紫',
         'A,2,黄緑',
         'B,10,黄',
         'C,3,青紫');

# 第3項が自分で決めた順番になるようにソートする $i = 0; undef(%color); foreach $name ('赤', '黄赤', '黄', '黄緑', '緑', '青緑', '青', '青紫', '紫', '赤紫') { $color{$name} = $i++; } @data = map {$_->[0]} sort {$color{$a->[3]} <=> $color{$b->[3]}} map {[$_, split /,/]} @data;

ソート後のデータ
@data = ('B,4,赤',
         'B,10,黄',
         'A,2,黄緑',
         'A,7,緑',
         'C,6,青',
         'C,3,青紫',
         'A,9,紫');

ソートの基本的な動作は﹁特定の項目でソートする﹂で説明した内容と同じです．自分で決めた順番でソートするためには，その順番を数字に変換できるようにハッシュに定義しておき，あとはその数字を使ってソートするだけです．このスクリプトでは，第3項の色が赤，黄赤，黄，黄緑，緑，青緑，青，青紫，紫，赤紫という順番になるようにソートしています．色の名前のままではソートすることはできませんので，順に 0～9 の数字に対応するようにハッシュを定義しています．ソートするときは，このハッシュから対応する数字に変換し，数字の比較でソートします．トップへ

年月日から曜日を求める

# $year年 $mon月 $mday日の曜日を求める use Time::Local; $time = timelocal(0, 0, 0, $mday, $mon - 1, $year - 1900); ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time); $wday_string = (qw(日月火水木金土))[$wday];
timelocal 関数を使って，まずは年月日時分秒を 1970年1月1日00時00分00秒からの秒数(MacPerl では 1904年1月1日00時00分00秒からの秒数)に変換します．このとき年と月の引数はそれぞれ - 1900， - 1 する必要があります．次に，その秒数から localtime 関数を使って曜日 $wday (0～6)を求めます．最後にその数字を文字列に変換してあげます．通常は上の書き方で問題ないのですが，ほとんどの計算機で 1970年～2037年までしか計算できないという制限があります．そこで，この範囲を超えるような場合があるときはツェラー(Zellar)の公式というものを使って次のように書きます．ツェラーの公式を使えば制限はありませんし，実行速度も速いのですが，すぐに思い出せない，覚えられないという欠点があります． # $year年 $mon月 $mday日の曜日を求める $wday = getwday($year, $mon, $mday); $wday_string = (qw(日月火水木金土))[$wday]; sub getwday { my($year, $mon, $mday) = @_; if ($mon == 1 or $mon == 2) { $year--; $mon += 12; } int($year + int($year / 4) - int($year / 100) + int($year / 400) + int((13 * $mon + 8) / 5) + $mday) % 7; }
トップへ

一週間前の年月日を求める

# 一週間前の年月日($year年 $mon月 $mday日)を求める use Time::Local; # 一週間前の時間を求める $time = time() - 60 * 60 * 24 * 7; ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time); $year += 1900; $mon++;
現在の時間を time 関数で求め，その秒数から一週間前の時間になるように 60 * 60 * 24 * 7 を引いてあげます．この秒数を localtime 関数を使って年月日に変換します． localtime 関数が返す値は，年が西暦から 1900を引いた値で，月は 0～11までの値を返します．したがって，最後に年と月をそれぞれ + 1900， + 1 する必要があります．time 関数を返す値を大きくすれば未来の年月日を求めることができます．年月日や時間に関するモジュール Date::Calc を使っても同じようなことができますが，標準のモジュールではないためアーカイブファイルを取ってきてインストールする必要があります．トップへ

年月から末日を求める

# $year年 $mon月の末日 $lastday を求める $lastday = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)[$mon - 1] + ($mon == 2 and $year % 4 == 0 and ($year % 400 == 0 or $year % 100 != 0));
最初の行は 1月から 12月までの末日を並べたリスト値に対して，添え字 $mon - 1 に対応する値を取り出しています． 2行目，3行目は閏年のための補正です．基本的に4で割れる年は閏年だが， 100で割れる年のときは閏年ではない，ただし，400で割れる年は閏年である．言い換えると，4で割れる年のうち and ( 400で割れる年と or 100で割れない年 ) が閏年ということになります．閏年の 2月の末日を計算するときという条件を表わしたものが 2行目，3行目です． Perlでは and や orは，最後に評価した値を返します．また，== や != は真のときに 1，偽のときに空文字列を返します．このことから， 2行目，3行目の条件式は閏年の 2月の末日を計算するときは1，そうでないときは空文字列を返すことになります．これをリスト値から取り出した末日に加えます．+ は数値の和を求める演算子ですので，空文字列のときは数値として解釈できないので 0 に変換されます．トップへ

第N W曜日の日付を求める

# $year年 $mon月の第$n $wday(0-6)曜日が何日か求める # getwday() は別途参照 $wday1 = getwday($year, $mon, 1); $mday = 1 + ($wday - $wday1) % 7 + 7 * ($n - 1); print $mday, "\n";
まず初めに，その月の 1日の曜日 $wday1 を求めます．年月日から曜日を求める方法については，﹁年月日から曜日を求める﹂を参照してください．次に 1日を基準に求めたい日付を計算します．求めたい曜日 $wday と 1日の曜日 $wday1 の差を加えてあげれば第1$wday曜日の日付を求めることができます．しかし，ここで単純に加えたのでは差が負数の場合にまずいことになります．そこで if文で場合分けしてもよいのですが，7で割った余り(必ず非負数)を求めれば，うまく第1$wday曜日の日付を求めることができます．最後に $n番目の $wday曜日の日付を求めるために 7 * ($n - 1) を加えて終わりです．求めた日付が本当に存在するかどうかは，﹁年月から末日を求める﹂で書いたように末日を求めて比較すればよいことになります．年月日や時間に関するモジュール Date::Calc を使っても同じようなことができますが，標準のモジュールではないためアーカイブファイルを取ってきてインストールする必要があります．トップへ

数字を3桁ごとにコンマで区切る

1 while s/^([-+]?\d+)(\d\d\d)/$1,$2/;
このスクリプトの while の前の 1は特に意味がないダミーの式です．本当に行ないたい部分は while 文の条件式の部分の置換です．このスクリプトは，置換が行なわれると条件式が真になり，ダミーの式である 1 を実行し，再び置換を行なおうとします．置換が行なわれるとコンマが 1つ追加されます．つまり，コンマを 1つずつ追加していき，追加できなくなった時点で while 文が終了することになります．では，実際にどのように置換しコンマを追加しているのか説明します． ^([-+]?\d+) の部分が，数字を先頭から見て，符号を考慮にいれつつ数字である限りできるだけ伸ばそうとします．ところが，その後ろに (\d\d\d) というのがあるので，少なくとも数字を 3つ残さなければパターンマッチできません．したがって，$1 には後ろに数字を 3つ残した前の部分の数字，$2 には残された 3つの数字が代入されることになります．その間にコンマを入れてあげます．これでコンマが 1つ追加されます．これを繰り返すことで数字全体に対して 3桁ごとにコンマで区切ることができます．つまり，このスクリプトでは数字を桁の小さい方から 3桁ずつ大きい方に向かって区切っています． while 文を使った方法よりも，次のように書いた方が桁が大きい場合には実行速度が速いです． s/(\d{1,3})(?=(?:\d\d\d)+(?!\d))/$1,/g;
このスクリプトは修飾子g を使うことで，置換文だけで数字をコンマで区切っています．コンマで区切る方法も while 文を使った置換と違い，桁の大きい方から区切っています．どのように区切っているのか説明します．ここで一番注目しなければいけないのが， (?=regex) の部分です．これは正規表現 regex にマッチする文字列が次にくる場合にマッチする 0文字幅の正規表現です．﹁0文字幅﹂というのは，文字列の先頭や最後を表わす ^ や $ のように，文字としての幅がないという意味です．ちょうど \b が単語の境界にマッチするように，(?=regex) も文字と文字の間でマッチするものと考えるといいでしょう．﹁次にくる場合﹂というのは，たとえば foo(?=bar) という正規表現の場合，foo や foohoge などはマッチしません．なぜなら foo の次に bar がこないからです．foobar の場合はマッチするわけですが，マッチするのは foo の部分だけです．(?=bar) は次に bar がこなければならないと言っているだけで bar を含んでいるわけではないからです．これが正規表現 foobar と foo(?=bar) の違いです．(?!regex) は (?=regex) の否定の形で，次にこない場合にマッチします．話をスクリプトに戻しますと，(?=(?:\d\d\d)+(?!\d)) は数字が次にこないような，3桁の数字の 1回以上の繰り返しが次にくることを表わしています．数字が次にこないということは数字の終わりを意味しています． $ と違って文字列の最後でなくても数字が終わっている部分にマッチするということです．全体として，桁の小さい方から 3桁ずつ数字をまとめているわけです．ただし，(?=regex) ですので， 3桁ずつ数字をまとめたものが次にくると言っているだけで，それを含んでしまっているわけではありません．そして，一番桁の大きい部分が (\d{1,3}) にマッチします．この部分の後ろにコンマを追加します．これで 1つコンマが追加されたわけですが，修飾子 gによって他にも置換できるところをすべて置換しにいきます．このときに先ほど﹁含んでいない﹂と言った部分が効いてきます．最初の置換で実際にマッチした数字は一番桁の大きい部分のところです．次に修飾子g によって他のところを置換しにいくときは，このマッチした部分の次から置換を始めようとします．もし，含んでしまっていたら，数字全体にマッチしてしまいますので，コンマが 1つしか追加されずに終了してしまいます．このスクリプトでは小数のことを考えていないので，小数点以下の部分までコンマで区切ってしまうという問題点があります．これを修正したものが次のスクリプトです． s/\G((?:^[-+])?\d{1,3})(?=(?:\d\d\d)+(?!\d))/$1,/g;
\G はパターンマッチの開始位置にマッチします．これが入っていることで，いきなり小数点以下部分にマッチしたりすることがなくなり，前回マッチした部分のすぐ次の桁からの部分にだけ注目して置換を行なうことができるようになります．\G のことは﹁正しくパターンマッチさせる﹂の中でも触れています．実行速度ですが，私がベンチマークをとって調べたところ， 2番目の方法よりもその修正版である 3番目の方法の方があらゆる場合において実行速度が速かったです． 1番目の方法と 3番目の方法ですが， 6桁以上の数字においては 3番目の方法の方が実行速度が速かったです．5桁以下では 1番目の方法が一番速かったのです．もし，実行速度を気にするのであれば，次のように書く方法があります．実行速度は上記のどの方法よりも速いです．符号や小数にも対応しています． # $num を3桁ごとにコンマで区切る(高速版) $num = reverse(join(',', reverse($num) =~ /((?:^\d+\.)?\d{1,3}[-+]?)/g)) if $num =~ /^[-+]?\d\d\d\d/;
このスクリプトは数字を一旦ひっくり返してから，前から 3桁ごとに区切り，それらをコンマで連結した上で再度ひっくり返しています．このスクリプトのように複雑な正規表現を避けたり，パターンマッチ文の評価回数を少なくしたりすることで実行速度を速くできる場合があります． if 文ですが，これがなくても動作します．しかし，その場合は 3桁以下の場合，つまり，全くコンマで区切る必要がない場合においても，数字をひっくり返してから元に戻すという作業が発生してしまい実行速度が遅くなってしまいます．if 文は数字の絶対値が 1000 以上であるとしてもいいのですが，私がベンチマークをとってみたところ，このスクリプトのように正規表現で判断した方が実行速度が速かったです．ただ，一般にパターンマッチは遅いものなので，他の組み込み関数で簡単に代用できる場合は正規表現を避けた方が実行速度が速くなることが多いです．次のスクリプトは複雑な正規表現を避け，組み込み関数で代用するということを更に進めたものです．実行速度は最速です．もちろん，符号や小数にも対応しています． # $num を3桁ごとにコンマで区切る(最速版) if ($num =~ /^[-+]?\d\d\d\d+/g) { for ($i = pos($num) - 3, $j = $num =~ /^[-+]/; $i > $j; $i -= 3) { substr($num, $i, 0) = ','; } }
このスクリプトはまず初めに if文で，全くコンマで区切る必要がない場合に無駄な処理をさせないという判断を行なうと同時に，どこまでが整数部分であるのかということもチェックしています．正規表現の最後に + がつけてあるので小数点が来るか，または，文字列の最後に達するかするまでできるだけ長くマッチしようとします．したがって，この正規表現で整数部分がすべてマッチすることになります．このパターンマッチにおいてに修飾子 g がつけられているところに注意してください．修飾子 gをつけたパターンマッチをスカラーコンテキストで評価した場合，パターンマッチ対象となった文字列は前回マッチした場所を記憶しています．そのため，もう一度同じ文字列に対して修飾子 gをつけたパターンマッチを行なうと，続きからパターンマッチが行なわれるようになります．このスクリプトでは pos 関数によって前回マッチした場所の記憶，すなわち，整数部分が文字列のどの位置までかということを取得しています．この情報を使ってコンマを追加することで小数点以下の場所までコンマを追加することがなくなります．整数部分の最後の場所がわかれば，後は 3文字ごとにコンマを追加していくことになります．このスクリプトでは追加の作業を substr 関数で行なっています．この関数の第3引数が 0 なので文字と文字の間に文字列，この場合は，コンマを追加することになります．このとき単純に 3文字ごとに追加していったのでは，符号がついていた場合に符号と数字の間に間違ってコンマを追加してしまう場合があります．そのため，符号がついていた場合には符号を含めないように処理を止めるようにしています．具体的には，$j の値は符号がついていなければ空文字列，符号がついていれば 1 になります．空文字列は比較するときには 0 と解釈されます．トップへ

数字を四捨五入する

# $num を四捨五入して小数点以下 $decimals桁にする sub round { my ($num, $decimals) = @_; my ($format, $magic); $format = '%.' . $decimals . 'f'; $magic = ($num > 0) ? 0.5 : -0.5; sprintf($format, int(($num * (10 ** $decimals)) + $magic) / (10 ** $decimals)); }

# 計算例
$number = 1.2345;
$number_0 = round($number, 0);  # 四捨五入して整数にする
$number_2 = round($number, 2);  # 小数点以下2桁まで求める
$number_3 = round($number, 3);  # 小数点以下3桁まで求める
print $number_0, "\n";          # --> 1
print $number_2, "\n";          # --> 1.23
print $number_3, "\n";          # --> 1.235

四捨五入の基本は，正数の小数点以下を四捨五入して正整数にすることです．これをやるには，0.5 を加えて int 関数で小数点以下を削除すればできます．小数点以下 n桁のところで四捨五入したい場合は，まず10の (n - 1) 乗します．これで四捨五入したい桁の部分が小数第1位のところにきます．あとは基本どおりに四捨五入し，今度は10の -(n - 1) 乗してもとの桁に戻します．負数の場合は，0.5 を加えるのではなく引くというところが違い，あとは正数の場合と同じです．こうして求めた数値はそのままでは正確に求めたい桁数になっていない場合があります．そこで最後に sprintf 関数を使って不要な桁を削除しています．単に小数点以下の特定の桁までに数字を丸めたい場合には，次にように sprintf の %f を使えば可能です．

# $num を小数点以下 $decimals桁までに丸める(完全な四捨五入ではない)

$num = sprintf("%.${decimals}f", $num);

完全な四捨五入ではないと書いたのは，特定の条件下では結果が四捨五入とならないからです．例えば 0.15 を小数第2位で四捨五入して，小数点以下1桁までにした結果の 0.2 を期待して， printf("%.1f\n", 0.15); と書いても，ほとんどの環境で 0.2 とはならずに 0.1 と表示されることでしょう．トップへ

数字を切り上げる

# $num を切り上げて小数点以下 $decimals桁にする sub ceil { my ($num, $decimals) = @_; my ($format, $tmp1, $tmp2); $format = '%.' . $decimals . 'f'; $tmp1 = $num * (10 ** $decimals); $tmp2 += $tmp1 <=> ($tmp2 = int($tmp1)); sprintf($format, $tmp2 / (10 ** $decimals)); }

# 計算例
$number = 1.2345;
$number_0 = ceil($number, 0);  # 切り上げて整数にする
$number_2 = ceil($number, 2);  # 小数点以下2桁まで求める
$number_3 = ceil($number, 3);  # 小数点以下3桁まで求める
print $number_0, "\n";          # --> 2
print $number_2, "\n";          # --> 1.24
print $number_3, "\n";          # --> 1.235

このスクリプトの基本は﹁数字を四捨五入する﹂のスクリプトと同じです．実際に切り上げを行なっている部分は， sprintf 関数の直前の文です．この文をわかりやすく書きかえると次のようになります．

  $tmp2 = int($tmp1) + ($tmp1 <=> int($tmp1));

これは，小数点以下を切り落とした数字と元の数字を比較して，もし違えば切り上げるということを行なっています．切り上げる方向は絶対値が大きくなる方向です．モジュール POSIX の ceil 関数を使えば切り上げを行なうことができますが，この関数は切り上げて整数にすることしかやってくれません．また，切り上げる方向は正の方向ですので，負数を切り上げる場合には注意が必要です．トップへ

配列から重複した要素を取り除く

# 配列 @array から重複した要素を取り除く { my %count; @array = grep(!$count{$_}++, @array); }
このようにすると配列の要素の出現順序が保存されます．また，ハッシュ %count には配列の要素をキーとし，その値には出現回数が入っています．出現回数の否定を条件式とすることで重複した要素を取り除くことができます．具体的には，初めて出現したときは出現回数を 0回から 1回に ++ するわけですが，そのときの条件式は !0 となり真となります．次に出現したとき，つまり，重複していたときは，出現回数1 以上の数値に対しての否定となり必ず偽となります．ハッシュ %count は局所化されていますので，このブロックを抜けた時点で自動的に消滅します．もし，出現回数を利用したいのであれば，このブロック内で利用するか，または，次のように書くことで後から利用することができます． # 配列 @array から重複した要素を取り除く # 後から出現回数を利用したい undef(%count); @array = grep(!$count{$_}++, @array);
トップへ

配列をランダムに並び替える

# 配列 @array をランダムに並び替える srand; for (my $i = @array; --$i; ) { my $j = int rand ($i + 1); next if $i == $j; @array[$i, $j] = @array[$j, $i]; }
srand 関数は rand 関数を使う前に一度だけ実行しておく必要があります．もし， srand 関数を実行しておかないといつも同じ結果になってしまいます．ただ，perl5.004 以降では rand 関数が使われたときに，まだ一度も srand 関数を実行していなかった場合には自動で実行してくれます． $i = @array では @array がスカラーコンテキストで実行されますので，配列の大きさを返します．このスクリプトの for 文は (配列の大きさ - 1)回実行され，for 文のブロックの中の 3つ目の文で要素の入れ替えを配列スライスを使って行なっています．$i の初期値は配列の大きさ，つまり，(最後の添え字の値 + 1) となっているのですが，条件文 --$i が評価されるときに - 1 されますので，for 文のブロックの中に入るときには (最後の添え字の値) になっています．もし，元の配列を残しておきたいのならば次のように書きます． # 配列 @old をランダムに並び替えた配列 @new を作る srand; @new = (); foreach (@old) { my $r = int rand (@new + 1); push(@new, $new[$r]); $new[$r] = $_; }
このスクリプトは配列の要素を入れ替えるという先ほどのスクリプトと違い，要素を 1つずつ新しい配列に追加していくのですが，そのときに新しい要素はランダムに選んだ場所に入れ，もともとそこにあった要素を一番最後に移動させるというものです．トップへ

戻る

Perlメモ

更新履歴

目次

はじめに

排他制御(ファイルロック)をする

ファイルの中身を逆順に表示する

ファイルの最後の数行だけ表示する

ファイルから 1行ランダムに選択する

ディレクトリ(フォルダ)サイズを求める

タグを削除する

自動で URI(URL) のリンクを張る

文字の正規表現

HTMLタグの正規表現

URI(URL) の正規表現

http URL の正規表現

ftp URL の正規表現

メールアドレスの正規表現

日本語を扱う

perl スクリプトは EUC-JP で書く

漢字コードを EUC-JP に変換して処理する

漢字コードを調べる

全角文字が含まれているか判定する

文字が途切れているか判定する

全角英数字を半角英数字に変換する

半角カタカナを全角カタカナに変換する

正しくパターンマッチさせる

前後の空白文字(全角スペース含)を削除する

文字単位に分割する

特定の長さで折り返す

Base64エンコード・デコードする

URIエスケープ・アンエスケープする

改行コードを統一する

改行コードを <BR> に変換する

改行コードを削除する

CSV形式の行から値のリストを取り出す

値に改行コードを含む CSV形式を扱う

値のリストから CSV形式に変換する

特定の項目でソートする

複数の項目でソートする

自分で決めた順番でソートする

年月日から曜日を求める

一週間前の年月日を求める

年月から末日を求める

第N W曜日の日付を求める

数字を3桁ごとにコンマで区切る

数字を四捨五入する

数字を切り上げる

配列から重複した要素を取り除く

配列をランダムに並び替える