File Coverage

blib/lib/Encode/Unicode/PerlDecodeJava.pm
Criterion Covered Total %
statement 40 40 100.0
branch 11 12 91.6
condition n/a
subroutine 9 9 100.0
pod 0 3 0.0
total 60 64 93.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             #-------------------------------------------------------------------------------
3             # Encode a Unicode string in Perl and decode it in Java
4             # Philip R Brenan at gmail dot com, Appa Apps Ltd, 2017
5             #-------------------------------------------------------------------------------
6              
7             package Encode::Unicode::PerlDecodeJava;
8             require v5.16.0;
9 1     1   941 use warnings FATAL => qw(all);
  1         3  
  1         47  
10 1     1   8 use strict;
  1         2  
  1         41  
11 1     1   8 use Carp;
  1         2  
  1         99  
12 1     1   612 use utf8;
  1         17  
  1         6  
13              
14             our $VERSION = '20170808';
15              
16             sub encode93($) # Encode a string
17 12     12 0 2326 {my ($i) = @_;
18 12         17 my $s;
19 12         25 my $n = length($i);
20 12         34 for(split //, $i) # Letters are passed straight through
21 78 100       193 {$s .= /[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ '\(\)\[\]\{\}<>`!@#\$%^&*_\-+=,;:|.?\/]/ ? $_ : ord($_).'~';
22             }
23 12         103 $s =~ s/([0123456789])(~)([^0123456789]|\Z)/$1$3/gsr; # Remove redundant ~
24             }
25              
26             sub decode93($) # Decode a string
27 6     6 0 13 {my ($i) = @_;
28 6         9 my $s;
29 6         9 my $n = '';
30 6         24 for(split //, $i) # Letters are passed straight through
31 114 100       218 {if ( /[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ '\(\)\[\]\{\}<>`!@#\$%^&*_\-+=,;:|.?\/]/)
    100          
32 19 100       36 {if (length($n)) {$s .= pack('U', $n); $n = ''} # Number terminated by letter not ~
  3         8  
  3         6  
33 19         27 $s .= $_
34             }
35 14         29 elsif (/~/i) {$s .= pack('U', $n); $n = ''} # Decompress number
  14         19  
36 81         117 else {$n .= $_}
37             }
38 6 100       19 if (length($n)) {$s .= pack('U', $n)} # Trailing number
  3         14  
39             $s
40 6         18 }
41              
42             #-------------------------------------------------------------------------------
43             # Test
44             #-------------------------------------------------------------------------------
45              
46             sub test
47 1 50   1 0 442 {eval join('', ) || die $@
  1     1   58228  
  1         13  
  1         93  
48             }
49              
50             test unless caller();
51              
52             # Documentation
53             #extractDocumentation unless caller;
54              
55             #-------------------------------------------------------------------------------
56             # Export
57             #-------------------------------------------------------------------------------
58              
59             require Exporter;
60              
61 1     1   670 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         3  
  1         270  
62              
63             @ISA = qw(Exporter);
64             @EXPORT = qw(decode93 encode93);
65             @EXPORT_OK = qw();
66             %EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);
67              
68             1;
69              
70             =pod
71              
72             =encoding utf-8
73              
74             =head1 Name
75              
76             Encode::Unicode::PerlDecodeJava - Encode a Unicode string in Perl and decode it in Java
77              
78             =head1 Synopsis 𝝰
79              
80             use Encode::Unicode::PerlDecodeJava;
81              
82             ok $_ eq decode93(encode93($_)) for(qw(aaa (𝝰𝝱𝝲) aaa𝝰𝝱𝝲aaa yüz))
83              
84             =head1 Description
85              
86             encode93($input)
87              
88             encodes any Perl string given as $input, even one containing Unicode
89             characters, using only the 93 well known ASCII characters below:
90              
91             abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ
92             0123456789 '()[]{}<>`!@#$%^&*_-+=,;:|.?\
93              
94             and returns the resulting encoded string.
95              
96             Such a string can be easily compressed and transported using software
97             restricted to ASCII data and then reconstituted as a Unicode string in Perl by
98             using decode93() or in Java by using the code reproduced further below.
99              
100             decode93($input)
101              
102             takes an $input string encoded by encode93() and returns the decoded string.
103              
104             The following Java code takes a string encoded by encode93() and (inefficiently)
105             returns the decoded string to Java:
106              
107             String decode93(String input) // Decode string encoded by encode93()
108             {final StringBuilder s = new StringBuilder();
109             final StringBuilder n = new StringBuilder();
110             final int N = input.length();
111              
112             for(int i = 0; i < N; ++i) // Decode each character
113             {char c = input.charAt(i);
114             if (Character.isDigit(c)) n.append(c); // Digit to accumulate
115             else if (c == '~') // Decode number
116             {final int p = Integer.parseInt(n.toString());
117             s.appendCodePoint(p);
118             n.setLength(0);
119             }
120             else // Letter
121             {if (n.length() > 0) // Number available for decode
122             {final int p = Integer.parseInt(n.toString());
123             s.appendCodePoint(p);
124             n.setLength(0);
125             }
126             s.append(c); // Add letter
127             }
128             }
129             if (n.length() > 0) // Trailing number available for decode
130             {final int p = Integer.parseInt(n.toString());
131             s.appendCodePoint(p);
132             n.setLength(0);
133             }
134             return s.toString(); // Decoded string
135             }
136              
137             =head1 Installation
138              
139             Standard Module::Build process for building and installing modules:
140              
141             perl Build.PL
142             ./Build
143             ./Build test
144             ./Build install
145              
146             =head1 Author
147              
148             philiprbrenan@gmail.com
149              
150             http://www.appaapps.com
151              
152             =head1 Copyright
153              
154             Copyright (c) 2017 Philip R Brenan.
155              
156             This module is free software. It may be used, redistributed and/or modified
157             under the same terms as Perl itself.
158              
159             =cut
160              
161             __DATA__