| 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 |  | 427 | use warnings FATAL => qw(all); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 43 |  | 
| 10 | 1 |  |  | 1 |  | 3 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 21 |  | 
| 11 | 1 |  |  | 1 |  | 2 | use Carp; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 49 |  | 
| 12 | 1 |  |  | 1 |  | 486 | use utf8; | 
|  | 1 |  |  |  |  | 8 |  | 
|  | 1 |  |  |  |  | 3 |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | our $VERSION = '2017.302'; | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | sub encode93($)                                                                 # Encode a string | 
| 17 | 12 |  |  | 12 | 0 | 4034 | {my ($i) = @_; | 
| 18 | 12 |  |  |  |  | 12 | my $s; | 
| 19 | 12 |  |  |  |  | 18 | my $n = length($i); | 
| 20 | 12 |  |  |  |  | 34 | for(split //, $i)                                                             # Letters are passed straight through | 
| 21 | 78 | 100 |  |  |  | 161 | {$s .=  /[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ '\(\)\[\]\{\}<>`!@#\$%^&*_\-+=,;:|.?\/]/ ? $_ : ord($_).'~'; | 
| 22 |  |  |  |  |  |  | } | 
| 23 | 12 |  |  |  |  | 101 | $s =~ s/([0123456789])(~)([^0123456789]|\Z)/$1$3/gsr;                         # Remove redundant ~ | 
| 24 |  |  |  |  |  |  | } | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | sub decode93($)                                                                 # Decode a string | 
| 27 | 6 |  |  | 6 | 0 | 7 | {my ($i) = @_; | 
| 28 | 6 |  |  |  |  | 4 | my $s; | 
| 29 | 6 |  |  |  |  | 5 | my $n = ''; | 
| 30 | 6 |  |  |  |  | 19 | for(split //, $i)                                                             # Letters are passed straight through | 
| 31 | 114 | 100 |  |  |  | 172 | {if (   /[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ '\(\)\[\]\{\}<>`!@#\$%^&*_\-+=,;:|.?\/]/) | 
|  |  | 100 |  |  |  |  |  | 
| 32 | 19 | 100 |  |  |  | 32 | {if (length($n)) {$s .= pack('U', $n); $n = ''}                            # Number terminated by letter not ~ | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 5 |  | 
| 33 | 19 |  |  |  |  | 17 | $s .= $_ | 
| 34 |  |  |  |  |  |  | } | 
| 35 | 14 |  |  |  |  | 28 | elsif (/~/i)      {$s .= pack('U', $n); $n = ''}                            # Decompress number | 
|  | 14 |  |  |  |  | 13 |  | 
| 36 | 81 |  |  |  |  | 69 | else              {$n .= $_} | 
| 37 |  |  |  |  |  |  | } | 
| 38 | 6 | 100 |  |  |  | 18 | if     (length($n)) {$s .= pack('U', $n)}                                     # Trailing number | 
|  | 3 |  |  |  |  | 10 |  | 
| 39 |  |  |  |  |  |  | $s | 
| 40 | 6 |  |  |  |  | 18 | } | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | #------------------------------------------------------------------------------- | 
| 43 |  |  |  |  |  |  | # Test | 
| 44 |  |  |  |  |  |  | #------------------------------------------------------------------------------- | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | sub test | 
| 47 | 1 | 50 |  | 1 | 0 | 548 | {eval join('', ) || die $@ | 
|  | 1 |  |  | 1 |  | 12412 |  | 
|  | 1 |  |  |  |  | 7 |  | 
|  | 1 |  |  |  |  | 100 |  | 
| 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 |  | 428 | use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 104 |  | 
| 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 returns the | 
| 105 |  |  |  |  |  |  | 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__ |