The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package ShiftJIS::Regexp::Equiv;
use strict;
use Carp;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
$VERSION = '1.03';

require Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw();
@EXPORT_OK = qw(%Eq);

use vars qw(%Eq);

my $Open = 5.005 > $] ? '(?:' : '(?-i:';
my $Close = ')';

foreach(
['!', 'I'],
['#', '”'],
['$', ''],
['%', '“'],
['&', '•'],
['(', 'i'],
[')', 'j'],
['*', '–'],
['+', '{'],
[',', 'C'],
['.', 'D'],
['/', '^'],
['0', '‚O'],
['1', '‚P'],
['2', '‚Q'],
['3', '‚R'],
['4', '‚S'],
['5', '‚T'],
['6', '‚U'],
['7', '‚V'],
['8', '‚W'],
['9', '‚X'],
[':', 'F'],
[';', 'G'],
['<', 'ƒ'],
['=', ''],
['>', '„'],
['?', 'H'],
['@', '—'],
['[', 'm'],
['\\',''],
[']', 'n'],
['^', 'O'],
['_', 'Q'],
['`', 'M'],
['{', 'o'],
['|', 'b'],
['}', 'p'],
['~', 'P'],
['B', '¡'],
['u', '¢'],
['v', '£'],
['A', '¤'],
['E', '¥'],
['[', '°'],
['a', '‚', 'A', '‚`'],
['b', '‚‚', 'B', '‚a'],
['c', '‚ƒ', 'C', '‚b'],
['d', '‚„', 'D', '‚c'],
['e', '‚…', 'E', '‚d'],
['f', '‚†', 'F', '‚e'],
['g', '‚‡', 'G', '‚f'],
['h', '‚ˆ', 'H', '‚g'],
['i', '‚‰', 'I', '‚h'],
['j', '‚Š', 'J', '‚i'],
['k', '‚‹', 'K', '‚j'],
['l', '‚Œ', 'L', '‚k'],
['m', '‚', 'M', '‚l'],
['n', '‚Ž', 'N', '‚m'],
['o', '‚', 'O', '‚n'],
['p', '‚', 'P', '‚o'],
['q', '‚‘', 'Q', '‚p'],
['r', '‚’', 'R', '‚q'],
['s', '‚“', 'S', '‚r'],
['t', '‚”', 'T', '‚s'],
['u', '‚•', 'U', '‚t'],
['v', '‚–', 'V', '‚u'],
['w', '‚—', 'W', '‚v'],
['x', '‚˜', 'X', '‚w'],
['y', '‚™', 'Y', '‚x'],
['z', '‚š', 'Z', '‚y'],
[qw/‚Ÿ ƒ@ § ‚  ƒA ± /],
[qw/‚¡ ƒB ¨ ‚¢ ƒC ² /],
[qw/‚£ ƒD © ‚¤ ƒE ƒ” ³Þ ³ /],
[qw/‚¥ ƒF ª ‚¦ ƒG ´ /],
[qw/‚§ ƒH « ‚¨ ƒI µ /],
[qw/‚ª ƒK ¶Þ ‚© ƒJ ¶ ƒ•/],
[qw/‚¬ ƒM ·Þ ‚« ƒL · /],
[qw/‚® ƒO ¸Þ ‚­ ƒN ¸ /],
[qw/‚° ƒQ ¹Þ ‚¯ ƒP ¹ ƒ– /],
[qw/‚² ƒS ºÞ ‚± ƒR º /],
[qw/‚´ ƒU »Þ ‚³ ƒT » /],
[qw/‚¶ ƒW ¼Þ ‚µ ƒV ¼ /],
[qw/‚¸ ƒY ½Þ ‚· ƒX ½ /],
[qw/‚º ƒ[ ¾Þ ‚¹ ƒZ ¾ /],
[qw/‚¼ ƒ] ¿Þ ‚» ƒ\ ¿ /],
[qw/‚¾ ƒ_ ÀÞ ‚½ ƒ^ À /],
[qw/‚À ƒa ÁÞ ‚¿ ƒ` Á /],
[qw/‚Ã ƒd ÂÞ ‚Â ƒc  ‚Á ƒb ¯/],
[qw/‚Å ƒf ÃÞ ‚Ä ƒe à /],
[qw/‚Ç ƒh ÄÞ ‚Æ ƒg Ä /],
[qw/‚È ƒi Å /],
[qw/‚É ƒj Æ /],
[qw/‚Ê ƒk Ç /],
[qw/‚Ë ƒl È /],
[qw/‚Ì ƒm É /],
[qw/‚Î ƒo ÊÞ ‚Ï ƒp Êß ‚Í ƒn Ê /],
[qw/‚Ñ ƒr ËÞ ‚Ò ƒs Ëß ‚Ð ƒq Ë /],
[qw/‚Ô ƒu ÌÞ ‚Õ ƒv Ìß ‚Ó ƒt Ì /],
[qw/‚× ƒx ÍÞ ‚Ø ƒy Íß ‚Ö ƒw Í /],
[qw/‚Ú ƒ{ ÎÞ ‚Û ƒ| Îß ‚Ù ƒz Î /],
[qw/‚Ü ƒ} Ï /],
[qw/‚Ý ƒ~ Ð /],
[qw/‚Þ ƒ€ Ñ /],
[qw/‚ß ƒ Ò /],
[qw/‚à ƒ‚ Ó /],
[qw/‚á ƒƒ ¬ ‚â ƒ„ Ô /],
[qw/‚ã ƒ… ­ ‚ä ƒ† Õ /],
[qw/‚å ƒ‡ ® ‚æ ƒˆ Ö /],
[qw/‚ç ƒ‰ × /],
[qw/‚è ƒŠ Ø /],
[qw/‚é ƒ‹ Ù /],
[qw/‚ê ƒŒ Ú /],
[qw/‚ë ƒ Û /],
[qw/‚í ƒ Ü ‚ì ƒŽ /],
[qw/‚î ƒ /],
[qw/‚ï ƒ‘ /],
[qw/‚ð ƒ’ ¦ /],
[qw/‚ñ ƒ“ Ý /],
[qw/T R U S /],
[qw/J K Þ  ß  /],
) {
    my $arr = $_;
    my $re = $Open.join('|', map {
	length($_) == 1
	    ? sprintf('\x%02x', ord $_)
	    : sprintf('\x%02x\x%02x', unpack 'C2', $_)
	} @$arr) .$Close;
    @Eq{@$arr} = ($re) x @$arr;
}

1;
__END__