File Coverage

blib/lib/ShiftJIS/Regexp/Equiv.pm

Criterion	Covered	Total	%
statement	12	12	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	16	16	100.0

line	stmt	sub	time	code
1				package ShiftJIS::Regexp::Equiv;
2	6	6	40	use strict;
	6		11
	6		383
3	6	6	37	use Carp;
	6		12
	6		508
4
5	6	6	33	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
	6		12
	6		718
6				$VERSION = '1.03';
7
8				require Exporter;
9				@ISA = qw(Exporter);
10				@EXPORT = qw();
11				@EXPORT_OK = qw(%Eq);
12
13	6	6	32	use vars qw(%Eq);
	6		10
	6		4982
14
15				my $Open = 5.005 > $] ? '(?:' : '(?-i:';
16				my $Close = ')';
17
18				foreach(
19				['!', '�I'],
20				['#', '��'],
21				['$', '��'],
22				['%', '��'],
23				['&', '��'],
24				['(', '�i'],
25				[')', '�j'],
26				['*', '��'],
27				['+', '�{'],
28				[',', '�C'],
29				['.', '�D'],
30				['/', '�^'],
31				['0', '�O'],
32				['1', '�P'],
33				['2', '�Q'],
34				['3', '�R'],
35				['4', '�S'],
36				['5', '�T'],
37				['6', '�U'],
38				['7', '�V'],
39				['8', '�W'],
40				['9', '�X'],
41				[':', '�F'],
42				[';', '�G'],
43				['<', '��'],
44				['=', '��'],
45				['>', '��'],
46				['?', '�H'],
47				['@', '��'],
48				['[', '�m'],
49				['\\','��'],
50				[']', '�n'],
51				['^', '�O'],
52				['_', '�Q'],
53				['`', '�M'],
54				['{', '�o'],
55				['\|', '�b'],
56				['}', '�p'],
57				['~', '�P'],
58				['�B', '�'],
59				['�u', '�'],
60				['�v', '�'],
61				['�A', '�'],
62				['�E', '�'],
63				['�[', '�'],
64				['a', '��', 'A', '�`'],
65				['b', '��', 'B', '�a'],
66				['c', '��', 'C', '�b'],
67				['d', '��', 'D', '�c'],
68				['e', '��', 'E', '�d'],
69				['f', '��', 'F', '�e'],
70				['g', '��', 'G', '�f'],
71				['h', '��', 'H', '�g'],
72				['i', '��', 'I', '�h'],
73				['j', '��', 'J', '�i'],
74				['k', '��', 'K', '�j'],
75				['l', '��', 'L', '�k'],
76				['m', '��', 'M', '�l'],
77				['n', '��', 'N', '�m'],
78				['o', '��', 'O', '�n'],
79				['p', '��', 'P', '�o'],
80				['q', '��', 'Q', '�p'],
81				['r', '��', 'R', '�q'],
82				['s', '��', 'S', '�r'],
83				['t', '��', 'T', '�s'],
84				['u', '��', 'U', '�t'],
85				['v', '��', 'V', '�u'],
86				['w', '��', 'W', '�v'],
87				['x', '��', 'X', '�w'],
88				['y', '��', 'Y', '�x'],
89				['z', '��', 'Z', '�y'],
90				[qw/�� @ � �� A � /],
91				[qw/�� B � �� C � /],
92				[qw/�� D � �� E �� /],
93				[qw/�� F � �� G � /],
94				[qw/�� H � �� I � /],
95				[qw/�� K �� J � ��/],
96				[qw/�� M �� L � /],
97				[qw/�� O �� N � /],
98				[qw/�� Q �� P � �� /],
99				[qw/�� S �� R � /],
100				[qw/�� U �� T � /],
101				[qw/�� W �� V � /],
102				[qw/�� Y �� X � /],
103				[qw/�� [ �� Z � /],
104				[qw/�� ] �� \ � /],
105				[qw/�� _ �� ^ � /],
106				[qw/�� a �� ` � /],
107				[qw/�� d �� c � �� b �/],
108				[qw/�� f �� e � /],
109				[qw/�� h �� g � /],
110				[qw/�� i � /],
111				[qw/�� j � /],
112				[qw/�� k � /],
113				[qw/�� l � /],
114				[qw/�� m � /],
115				[qw/�� o �� p �� n � /],
116				[qw/�� r �� s �� q � /],
117				[qw/�� u �� v �� t � /],
118				[qw/�� x �� y �� w � /],
119				[qw/�� { �� \| �� z � /],
120				[qw/�� } � /],
121				[qw/�� ~ � /],
122				[qw/�� /],
123				[qw/�� /],
124				[qw/�� /],
125				[qw/�� /],
126				[qw/�� /],
127				[qw/�� /],
128				[qw/�� /],
129				[qw/�� /],
130				[qw/�� /],
131				[qw/�� /],
132				[qw/�� /],
133				[qw/�� /],
134				[qw/�� /],
135				[qw/�� /],
136				[qw/�� /],
137				[qw/�� /],
138				[qw/�T �R �U �S /],
139				[qw/�J �K � � /],
140				) {
141				my $arr = $_;
142				my $re = $Open.join('\|', map {
143				length($_) == 1
144				? sprintf('\x%02x', ord $_)
145				: sprintf('\x%02x\x%02x', unpack 'C2', $_)
146				} @$arr) .$Close;
147				@Eq{@$arr} = ($re) x @$arr;
148				}
149
150				1;
151				__END__