File Coverage

lib/Convert/Braille.pm
Criterion Covered Total %
statement 75 82 91.4
branch 29 50 58.0
condition 2 6 33.3
subroutine 13 13 100.0
pod 6 6 100.0
total 125 157 79.6


line stmt bran cond sub pod time code
1             package Convert::Braille;
2 1     1   15608 use utf8;
  1         2  
  1         17  
3              
4             BEGIN
5             {
6 1     1   22 require 5.006;
7 1     1   67 use warnings;
  1         3  
  1         78  
8 1     1   7 use base qw(Exporter);
  1         2  
  1         169  
9              
10 1     1   9 use strict;
  1         2  
  1         59  
11 1     1   9 use vars qw( @EXPORT @EXPORT_OK $VERSION %BrailleAscii_To_Unicode %BrailleUnicode_To_Ascii $dot_separator );
  1         2  
  1         483  
12              
13 1         4 $VERSION = '0.06';
14              
15 1         5 @EXPORT = qw(
16             brailleDotNumbers_To_Unicode
17             brailleUnicode_To_DotNumbers
18             brailleUnicode_To_Ascii
19             brailleAscii_To_Unicode
20              
21             brailleAscii_To_DotNumbers
22             brailleDotNumbers_To_Ascii
23             );
24 1         16 @EXPORT_OK = qw(
25             brailleDotNumbers_To_Unicode
26             brailleUnicode_To_DotNumbers
27             brailleUnicode_To_Ascii
28             brailleAscii_To_Unicode
29              
30             brailleAscii_To_DotNumbers
31             brailleDotNumbers_To_Ascii
32              
33             %BrailleAscii_To_Unicode
34             %Unicode_To_BrailleAscii
35             );
36              
37 1         76 %BrailleAscii_To_Unicode =(
38             A => '⠁',
39             B => '⠃',
40             C => '⠉',
41             D => '⠙',
42             E => '⠑',
43             F => '⠋',
44             G => '⠛',
45             H => '⠓',
46             I => '⠊',
47             J => '⠚',
48             K => '⠅',
49             L => '⠇',
50             M => '⠍',
51             N => '⠝',
52             O => '⠕',
53             P => '⠏',
54             Q => '⠟',
55             R => '⠗',
56             S => '⠎',
57             T => '⠞',
58             U => '⠥',
59             V => '⠧',
60             W => '⠺',
61             X => '⠭',
62             Y => '⠽',
63             Z => '⠵',
64              
65             1 => '⠂',
66             2 => '⠆',
67             3 => '⠒',
68             4 => '⠲',
69             5 => '⠢',
70             6 => '⠖',
71             7 => '⠶',
72             8 => '⠦',
73             9 => '⠔',
74             0 => '⠴',
75              
76             ',' => '⠄',
77             '@' => '⠈',
78             '/' => '⠌',
79             '"' => '⠐',
80             '^' => '⠘',
81             '>' => '⠜',
82             '\'' => '⠠',
83             '*' => '⠡',
84             '<' => '⠣',
85             '-' => '⠤',
86             '.' => '⠨',
87             '%' => '⠩',
88             '[' => '⠪',
89             '$' => '⠫',
90             '+' => '⠬',
91             '!' => '⠮',
92             '&' => '⠯',
93             ';' => '⠰',
94             ':' => '⠱',
95             '\\' => '⠳',
96             '(' => '⠷',
97             '_' => '⠸',
98             '?' => '⠹',
99             ']' => '⠻',
100             '#' => '⠼',
101             ')' => '⠾',
102             '=' => '⠿'
103             );
104              
105              
106 1         11 foreach ( keys %BrailleAscii_To_Unicode ) {
107 63         149 $BrailleUnicode_To_Ascii{$BrailleAscii_To_Unicode{$_}} = $_;
108             }
109              
110 1         1213 $dot_separator = "";
111              
112             }
113              
114             sub _convert
115             {
116 25 50   25   64 return unless ( defined($_[0]) );
117              
118 25         47 my ( $token, $hash ) = @_;
119              
120 25 50       104 ( exists($hash->{$token}) ) ? $hash->{$token} : $token ;
121             }
122              
123              
124             sub brailleAscii_To_Unicode
125             {
126              
127 3 50   3 1 213524 return unless ( defined($_[0]) );
128              
129 3         11 my $ascii = uc($_[0]);
130 3         16 $ascii =~ s/(.)/_convert ( $1, \%BrailleAscii_To_Unicode )/ge;
  15         30  
131 3         29 $ascii;
132             }
133              
134              
135             sub brailleUnicode_To_Ascii
136             {
137              
138 2 50   2 1 193 return unless ( defined($_[0]) );
139              
140 2         4 my $unicode = $_[0];
141              
142             #
143             # first strip off dots 7 and 8:
144             #
145 2 50       8 if ( $unicode =~ /⡀-⣿/ ) {
146 0         0 $unicode =~ tr/⢀-⣿/⠀-⡿/; # fold upper half
147 0         0 $unicode =~ tr/⡀-⡿/⠀-⠿/; # fold upper quarter
148             }
149 2         10 $unicode =~ s/(.)/_convert ( $1, \%BrailleUnicode_To_Ascii )/ge;
  10         35  
150 2         25 $unicode;
151             }
152              
153              
154             sub brailleUnicode_To_DotNumbers
155             {
156              
157 2     2 1 134 my $string = shift; # no || "" because fail for '0'
158 2 50 33     13 return "" if !defined $string || $string eq "";
159 2 50       7 my $braced = ( @_ ) ? shift : 0 ;
160              
161 2         8 my @chars = split ( //, $string );
162              
163 2         5 my ($trans, $dots);
164              
165 2         5 foreach ( @chars ) {
166 10 50       32 if ( /[⠀-⣿]/ ) { # assume UTF8
167 10         18 my $char = ord ( $_ ) - 0x2800;
168 10 100       22 $trans .= $dot_separator if ( $dots );
169 10         17 $dots = undef;
170 10 50       25 $dots = "1" if ( $char & 0x1 );
171 10 100       22 $dots .= "2" if ( $char & 0x2 );
172 10 100       22 $dots .= "3" if ( $char & 0x4 );
173 10 50       21 $dots .= "4" if ( $char & 0x8 );
174 10 100       21 $dots .= "5" if ( $char & 0x10 );
175 10 50       22 $dots .= "6" if ( $char & 0x20 );
176 10 50       17 $dots .= "7" if ( $char & 0x40 );
177 10 50       21 $dots .= "8" if ( $char & 0x80 );
178 10 50       25 $trans .= ($braced) ? "[$dots]" : $dots;
179             }
180             else {
181 0         0 $trans .= "$_";
182 0         0 $dots = undef;
183             }
184             }
185              
186 2         23 $trans;
187             }
188              
189              
190             sub brailleDotNumbers_To_Unicode
191             {
192              
193 2     2 1 156 my $string = shift;
194 2 50 33     14 return "" if !defined $string || $string eq "";
195              
196 2 50       6 $string =~ s/$dot_separator//g if( $dot_separator );
197              
198              
199 2         10 my @bits = split ( //, $string );
200              
201 2         6 my ($char, $lastBit, $trans) = (0,0,"");
202              
203 2         6 foreach ( @bits ) {
204 28         37 my $bit = $_;
205 28 50       80 if ( $bit =~ /[1-8]/ ) {
206 28 100       45 if ( $bit > $lastBit ) {
207             # bit continues sequence
208 20         37 $char += 2**($bit-1);
209             }
210             else {
211             # bit starts new sequence
212 8 50       23 $trans .= chr ( 0x2800+$char ) if ( $char ); # first time problem
213 8         14 $lastBit = $char = 0;
214 8         29 $char = 2**($bit-1);
215             }
216 28         51 $lastBit = $bit;
217             }
218             else { # end of sequence
219 0 0       0 $trans .= chr ( 0x2800+$char ) if ( $char ); # first time problem
220 0         0 $trans .= $bit;
221 0         0 $lastBit = $char = 0;
222             }
223             }
224 2 50       8 $trans .= chr ( 0x2800+$char ) if ( $char ); # last time problem
225            
226 2         18 $trans;
227             }
228              
229              
230             sub brailleAscii_To_DotNumbers
231             {
232 1     1 1 127 brailleUnicode_To_DotNumbers ( brailleAscii_To_Unicode ( @_ ) );
233             }
234              
235              
236             sub brailleDotNumbers_To_Ascii
237             {
238 1     1 1 192 brailleUnicode_To_Ascii ( brailleDotNumbers_To_Unicode ( @_ ) );
239             }
240              
241              
242             #########################################################
243             # Do not change this, Do not put anything below this.
244             # File must return "true" value at termination
245             1;
246             ##########################################################
247              
248             __END__