File Coverage

blib/lib/TeX/Encode.pm
Criterion Covered Total %
statement 99 124 79.8
branch 55 82 67.0
condition 6 12 50.0
subroutine 19 23 82.6
pod 3 3 100.0
total 182 244 74.5


line stmt bran cond sub pod time code
1             package TeX::Encode;
2              
3 4     4   333350 use 5.008;
  4         50  
4 4     4   21 use strict;
  4         7  
  4         117  
5              
6             #use AutoLoader qw(AUTOLOAD);
7              
8 4     4   21 use Encode::Encoding 0.1;
  4         68  
  4         96  
9 4     4   21 use Carp;
  4         8  
  4         311  
10              
11 4     4   2442 use TeX::Encode::charmap;
  4         57  
  4         260  
12 4     4   2182 use TeX::Encode::BibTeX;
  4         10  
  4         7830  
13              
14             our @ISA = qw(Encode::Encoding);
15              
16             our $VERSION = '2.010'; # VERSION
17              
18             __PACKAGE__->Define(qw(LaTeX latex));
19              
20             sub _bad_cp
21             {
22 1     1   219 return sprintf("Unsupported character code point 0x%04x\n", ord($_[0]));
23             }
24              
25             sub encode
26             {
27 19     19 1 10646 my( undef, $string, $check ) = @_;
28              
29 19         40 my $bad_cp = 0;
30              
31             # set up a "check" sub that will determine how we handle unsupported code
32             # points
33 19 50       47 $check = Encode::FB_DEFAULT if !defined $check;
34 19 100 66     237 if( $check eq Encode::FB_DEFAULT or $check eq "")
    100          
    50          
    0          
35             {
36 17     1   82 $check = sub { '?' };
  1         5  
37             }
38             elsif( $check eq Encode::FB_CROAK )
39             {
40 1     1   5 $check = sub { Carp::croak(&_bad_cp(@_)) };
  1         5  
41             }
42             elsif( $check eq Encode::FB_QUIET )
43             {
44 1     1   6 $check = sub { $bad_cp = 1; '' };
  1         2  
  1         5  
45             }
46             elsif( $check eq Encode::FB_WARN )
47             {
48 0     0   0 $check = sub { Carp::carp(&_bad_cp(@_)); $bad_cp = 1; '' };
  0         0  
  0         0  
  0         0  
49             }
50             else
51             {
52 0         0 Carp::confess( "Unknown check argument: expected one of undef, FB_DEFAULT, FB_CROAK, FB_QUIET or FB_WARN" );
53             }
54              
55 19         40 my $tex = "";
56              
57 19         59 pos($string) = 0;
58              
59 19         51 for($string)
60             {
61 19         45 while(!$bad_cp) {
62 53 100       124 last if pos($_) == length($_);
63              
64             # escape reserved characters
65 36 100       253 /\G($TeX::Encode::charmap::RESERVED_RE)/gc and ($tex .= $TeX::Encode::charmap::RESERVED{$1}, next);
66              
67             # escape all characters supported by tex
68 27 100       1010 if( /\G($TeX::Encode::charmap::CHAR_MAP_RE)/gc )
69             {
70 9         31 $tex .= $TeX::Encode::charmap::CHAR_MAP{$1};
71 9 100       23 if( /\G[a-zA-Z_]/gc )
72             {
73 2         6 --pos($_);
74 2 50       45 $tex =~ /[a-zA-Z_]$/ and $tex .= '{}';
75             }
76 9         27 next;
77             }
78              
79             # basic unreserved characters
80 18 100       116 /\G([\sa-zA-Z0-9\.,:;'"\(\)=\-\/\[\]\*\+!]+)/gc and ($tex .= $1, next);
81              
82             # unsupported code point (may set $bad_cp)
83 3 50       16 /\G(.)/gc and ($tex .= &$check(ord($1)), next);
84              
85 0         0 Carp::confess "Shouldn't happen";
86             }
87             }
88              
89 18 100       40 if( $bad_cp )
90             {
91 1         6 $_[1] = substr($string,pos($string)-1);
92             }
93              
94 18         87 return $tex;
95             }
96              
97             # decode($octets [,$check])
98             sub decode
99             {
100 42     42 1 13195 my( undef, $tex, $check ) = @_;
101              
102 42         114 pos($tex) = 0;
103              
104 42         117 my $str = "";
105              
106 42         108 while(pos($tex) < length($tex))
107             {
108 233         418 $str .= _decode( $tex, $check );
109             }
110              
111 42         110 return $str;
112             }
113              
114             sub _decode
115             {
116 238     238   491 my $str = Encode::decode_utf8( "" );
117              
118 238         3824 for($_[0])
119             {
120 238 50       530 /\G\%([^\n]+\n)?/gc and next; # comment
121             # not sure about this:
122             # /\G\\ensuremath/gc and ($str .= _decode_mathmode(_decode_bracket($_)), next); # mathmode
123 238 100       422 /\G\$/gc and ($str .= _decode_mathmode($_), next); # mathmode
124 229 100       7409 /\G($TeX::Encode::charmap::MACROS_RE)/gc and ($str .= $TeX::Encode::charmap::MACROS{$1}, next); # macro
125 73 100       159 /\G\\(.)/gc and ($str .= _decode_macro($1,$_), next); # unknown macro
126 72 100       137 /\G\{/gc and ($str .= _decode_brace($_), next); # {foo}
127 62 50       120 /\G\[/gc and ($str .= _decode_bracket($_), next); # [foo]
128 62 100       112 /\G_/gc and ($str .= _subscript(&_decode), next); # _ (subscript)
129 60 100       109 /\G\^/gc and ($str .= _superscript(&_decode), next); # ^ (superscript)
130 57 100       209 /\G([^_\^\%\$\\\{\[ \t\n\r]+)/gc and $str .= $1, next;
131 30 50       125 /\G([ \t\n\r])+/gc and $str .= $1, next;
132              
133 0         0 Carp::confess "Shouldn't happen: ".substr($_,0,10)." ...".substr($_,pos($_),10)." [".pos($_)."/".length($_)."]";
134             }
135              
136 238         672 return $str;
137             }
138              
139             sub _subscript
140             {
141 2     2   6 my( $tex ) = @_;
142 2 50       9 return $tex if $tex =~ /[^0-9+\-]/;
143 0         0 return _subscript_digits( $tex );
144             }
145              
146             sub _superscript
147             {
148 3     3   6 my( $tex ) = @_;
149 3 50       14 return $tex if $tex =~ /[^0-9+\-]/;
150 3         11 return _superscript_digits( $tex );
151             }
152              
153             my %SUBSCRIPTS = (
154             '+' => chr(0x208a),
155             '-' => chr(0x208b),
156             );
157             $SUBSCRIPTS{''.$_} = chr(0x2080+$_) for 0..9;
158             sub _subscript_digits
159             {
160 0     0   0 my( $tex ) = @_;
161 0         0 $tex =~ s/(.)/$SUBSCRIPTS{$1}/g;
162 0         0 return $tex;
163             }
164              
165             my %SUPERSCRIPTS = (
166             '0' => chr(0x2070),
167             '1' => chr(0xb9),
168             '2' => chr(0xb2),
169             '3' => chr(0xb3),
170             '4' => chr(0x2074),
171             '5' => chr(0x2075),
172             '6' => chr(0x2076),
173             '7' => chr(0x2077),
174             '8' => chr(0x2078),
175             '9' => chr(0x2079),
176             '+' => chr(0x207a),
177             '-' => chr(0x207b),
178             );
179             sub _superscript_digits
180             {
181 3     3   6 my( $tex ) = @_;
182 3         23 $tex =~ s/(.)/$SUPERSCRIPTS{$1}/g;
183 3         10 return $tex;
184             }
185              
186 0     0 1 0 sub perlio_ok { 0 }
187              
188             sub _decode_mathmode
189             {
190 9     9   16 my $str = "";
191              
192 9         19 for($_[0])
193             {
194 9         16 while(1) {
195 30 50       55 last if pos($_) == length($_);
196            
197 30 100       69 /\G(\\.)/gc and ($str .= $1, next);
198 22 100       51 /\G\$/gc and last;
199 13 50       77 /\G($TeX::Encode::charmap::MATH_CHARS_RE)/gc and ($str .= $TeX::Encode::charmap::MATH_CHARS{$1}, next);
200 13 50       54 /\G([^\\\$]+)/gc and ($str .= $1, next);
201              
202 0         0 Carp::confess "Shouldn't happen";
203             }
204             }
205              
206 9         24 return decode(undef, $str);
207             }
208              
209             # try again to expand a macro
210             sub _decode_macro
211             {
212 1     1   17 my( $c ) = @_;
213              
214 1         4 my $str = "\\$c";
215              
216 1         4 for($_[1])
217             {
218             # expand \'{e} to \'e
219 1 50       6 /\G\{/ and ($str .= _decode_brace( $_ ), next);
220 1         2 last;
221             }
222              
223 1   33     9 return $TeX::Encode::charmap::MACROS{$str} || $str;
224             }
225              
226             sub _decode_bracket
227             {
228 0     0   0 my $str = "";
229              
230 0         0 my $depth = 1;
231 0         0 for($_[0])
232             {
233 0         0 while(1) {
234 0 0 0     0 last if pos($_) == length($_) or $depth == 0;
235              
236 0 0       0 /\G(\\.)/gc and ($str .= $1, next);
237 0 0       0 /\G\[/gc and (--$depth, next);
238 0 0       0 /\G\]/gc and (++$depth, next);
239 0 0       0 /\G([^\\\[\]]+)/gc and ($str .= $1, next);
240              
241 0         0 Carp::confess "Shouldn't happen";
242             }
243             }
244              
245 0         0 return $str;
246             }
247              
248             sub _decode_brace
249             {
250 10     10   19 my $str = "";
251              
252 10         14 my $depth = 1;
253 10         20 for($_[0])
254             {
255 10         14 while(1) {
256 25 100 100     88 last if pos($_) == length($_) or $depth == 0;
257              
258 15 100       33 /\G(\\.)/gc and ($str .= $1, next);
259 14 100       35 /\G\}/gc and ($str .= '}', --$depth, next);
260 4 50       9 /\G\{/gc and ($str .= '{', ++$depth, next);
261 4 50       18 /\G([^\\\{\}]+)/gc and ($str .= $1, next);
262              
263 0         0 Carp::confess "Shouldn't happen";
264             }
265             }
266              
267 10         18 chop($str); # remove trailing '}'
268              
269 10         24 return decode(undef, $str);
270             }
271              
272             1;
273             __END__