File Coverage

blib/lib/Acme/Unicodify.pm
Criterion Covered Total %
statement 69 71 97.1
branch 10 12 83.3
condition n/a
subroutine 14 14 100.0
pod 5 5 100.0
total 98 102 96.0


line stmt bran cond sub pod time code
1             #
2             # Copyright (C) 2015 J. Maslak
3             # All Rights Reserved - See License
4             #
5              
6             package Acme::Unicodify;
7             # ABSTRACT: Convert ASCII text into look-somewhat-alike unicode
8             $Acme::Unicodify::VERSION = '0.007';
9 1     1   17665 use utf8;
  1         13  
  1         4  
10 1     1   31 use v5.22;
  1         6  
11              
12 1     1   4 use strict;
  1         6  
  1         19  
13 1     1   5 use warnings;
  1         1  
  1         40  
14              
15 1     1   245 use File::Slurper 0.008 qw(read_text write_text);
  1         10106  
  1         53  
16              
17              
18 1     1   7 use autodie;
  1         2  
  1         5  
19              
20 1     1   4514 use Carp;
  1         3  
  1         64  
21 1     1   435 use Unicode::Normalize;
  1         1521  
  1         788  
22              
23             my %_TRANSLATE = (
24             a => "\N{U+251}",
25             b => "\N{U+432}",
26             c => "\N{U+63}\N{U+30A}",
27             d => "\N{U+64}\N{U+30A}",
28             e => "\N{U+3F5}",
29             f => "\N{U+4FB}",
30             g => "\N{U+260}",
31             h => "\N{U+4A3}",
32             i => "\N{U+268}",
33             j => "\N{U+135}",
34             k => "\N{U+1E31}",
35             l => "\N{U+2113}",
36             m => "\N{U+271}",
37             n => "\N{U+1E47}",
38             o => "\N{U+26AC}",
39             p => "\N{U+3C1}",
40             q => "\N{U+24E0}",
41             r => "\N{U+27E}",
42             s => "\N{U+15B}",
43             t => "\N{U+1C0}\N{U+335}",
44             u => "\N{U+1D66A}\N{U+30A}",
45             v => "\N{U+22C1}",
46             w => "\N{U+2375}",
47             x => "\N{U+1E8B}",
48             y => "\N{U+1EFE}",
49             z => "\N{U+1D66F}",
50             A => "\N{U+10300}",
51             B => "\N{U+1D6C3}",
52             C => "\N{U+C7}",
53             D => "\N{U+1D673}",
54             E => "\N{U+395}",
55             F => "\N{U+4FA}",
56             G => "\N{U+1E4}",
57             H => "\N{U+10199}",
58             I => "\N{U+10309}",
59             J => "\N{U+1D4AF}",
60             K => "\N{U+212A}",
61             L => "\N{U+1D473}",
62             M => "\N{U+1D4DC}",
63             N => "\N{U+2115}",
64             O => "\N{U+2B55}",
65             P => "\N{U+5C38}",
66             Q => "\N{U+1F160}",
67             R => "\N{U+5C3A}",
68             S => "\N{U+10296}",
69             T => "\N{U+4E05}",
70             U => "\N{U+2F10}",
71             V => "\N{U+1D54D}",
72             W => "\N{U+174}",
73             X => "\N{U+274C}",
74             Y => "\N{U+1F1FE}",
75             Z => "\N{U+2621}"
76             );
77              
78              
79             sub new {
80 1     1 1 2634 my $class = shift;
81              
82 1         5 my $self = {};
83 1         4 bless $self, $class;
84              
85 1         7 $self->_define_cache();
86              
87 1         3 return $self;
88             }
89              
90              
91             sub to_unicode {
92 56     56 1 66 my $self = shift;
93 56         64 my $str = shift;
94              
95 56 100       87 if (!defined($str)) { return; }
  1         5  
96              
97 55         266 my @parts = split /\b{gcb}/, $str;
98 55         73 my $out = '';
99 55         74 foreach my $l (@parts) {
100 259 100       668 if ( exists( $_TRANSLATE{$l} ) ) {
101 214         356 $out .= $_TRANSLATE{$l};
102             } else {
103 45         67 $out .= $l;
104             }
105             }
106              
107 55         273 return NFD($out);
108             }
109              
110              
111             sub back_to_ascii {
112 4     4 1 261 my $self = shift;
113 4         7 my $str = shift;
114              
115 4 100       13 if (!defined($str)) { return; }
  1         6  
116              
117 3         155 my @parts = split /\b{gcb}/, $str;
118 3         6 my $out = '';
119 3         6 foreach my $l (@parts) {
120 207 100       326 if ( exists( $self->{_ASCII_CACHE}->{$l} ) ) {
121 140         269 $out .= $self->{_ASCII_CACHE}->{$l};
122             } else {
123 67         96 $out .= $l;
124             }
125             }
126              
127 3         26 return $out;
128             }
129              
130              
131             sub file_to_unicode {
132 1 50   1 1 5 if ($#_ != 2) { confess 'invalid call' }
  0         0  
133 1         3 my ($self, $in_fn, $out_fn) = @_;
134              
135 1         4 my $txt = read_text($in_fn);
136 1         75 $txt = $self->to_unicode($txt);
137 1         7 write_text($out_fn, $txt);
138              
139 1         110 return;
140             }
141              
142              
143             sub file_back_to_ascii {
144 1 50   1 1 1177 if ($#_ != 2) { confess 'invalid call' }
  0         0  
145 1         5 my ($self, $in_fn, $out_fn) = @_;
146              
147 1         3 my $txt = read_text($in_fn);
148 1         69 my $out = $self->back_to_ascii($txt);
149 1         4 write_text($out_fn, $out);
150              
151 1         104 return;
152             }
153              
154             sub _define_cache {
155 1     1   3 my $self = shift;
156              
157 1         8 $self->{_ASCII_CACHE} = {};
158              
159 1         3 my $i = 0;
160 1         24 foreach my $key (keys %_TRANSLATE) {
161 52         70 $i++;
162 52         81 $self->{_ASCII_CACHE}->{$self->to_unicode($key)} = $key;
163             }
164 1         4 return;
165             }
166              
167             1;
168              
169             __END__