From a50711ebbebd5ceb4f52a3f3324ddd58254e5620 Mon Sep 17 00:00:00 2001 From: Codex Date: Tue, 27 Oct 2026 11:08:33 +0100 Subject: [PATCH 1/2] fix: match Perl Encode MIME charset behavior Issue: #1897 Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- docs/about/changelog.md | 2 + .../perlonjava/runtime/perlmodule/Encode.java | 48 +++++++++++++++++-- .../unit/encode_mime_charset_aliases.t | 23 +++++++++ 3 files changed, 69 insertions(+), 4 deletions(-) create mode 100644 src/test/resources/unit/encode_mime_charset_aliases.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 5bb65bff8d..0c59016825 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,8 @@ priorities and future plans. ## Work in progress +- Match Perl `Encode` aliases for ANSI X3.4-1968, HZ-GB-2312, and ISO-8859-8-I, and include the BOM when encoding generic UTF-32 (#1897). + - Separate organizational and project issue queues, record temporary agent claims and dependencies, and keep agent checkpoints concise (#1895). - Preserve scalar context for short-circuit expressions passed to scalar prototypes (#1891). diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java b/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java index cb70baa085..13290a8ac1 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java @@ -81,6 +81,8 @@ public class Encode extends PerlModuleBase { CHARSET_ALIASES.put("ASCII", StandardCharsets.US_ASCII); CHARSET_ALIASES.put("us-ascii", StandardCharsets.US_ASCII); CHARSET_ALIASES.put("US-ASCII", StandardCharsets.US_ASCII); + CHARSET_ALIASES.put("ANSI X3.4-1968", StandardCharsets.US_ASCII); + CHARSET_ALIASES.put("ANSI_X3.4-1968", StandardCharsets.US_ASCII); CHARSET_ALIASES.put("utf16", StandardCharsets.UTF_16); CHARSET_ALIASES.put("UTF16", StandardCharsets.UTF_16); @@ -130,6 +132,25 @@ public class Encode extends PerlModuleBase { } catch (Exception ignored) { } + // Perl Encode treats HZ-GB-2312 as an alias for EUC-CN. The JDK has + // no HZ codec, but does provide the compatible EUC-CN/GB2312 charset. + try { + Charset eucCN = Charset.forName("GB2312"); + CHARSET_ALIASES.put("HZ-GB-2312", eucCN); + CHARSET_ALIASES.put("hz-gb-2312", eucCN); + CHARSET_ALIASES.put("euc-cn", eucCN); + CHARSET_ALIASES.put("EUC-CN", eucCN); + } catch (Exception ignored) { + } + + // The WHATWG visual-order Hebrew alias maps to Windows-1255. + try { + Charset hebrewVisual = Charset.forName("windows-1255"); + CHARSET_ALIASES.put("ISO-8859-8-I", hebrewVisual); + CHARSET_ALIASES.put("iso-8859-8-i", hebrewVisual); + } catch (Exception ignored) { + } + // Locale fallbacks before Encode::Locale has initialized its globals. // UTF-32 aliases try { @@ -583,11 +604,27 @@ public static RuntimeList encode(RuntimeArray args, int ctx) { if (check == FB_DEFAULT_VAL) { // Fast path: no error handling, use Java's default replacement byte[] bytes = string.getBytes(charset); - return new RuntimeScalar(bytes).getList(); + return addGenericUtf32Bom(new RuntimeScalar(bytes), encodingName, charset).getList(); } // Use shared encode helper - return encodeWithCharset(string, charset, encodingName, check, codeRef, args, 1).getList(); + RuntimeScalar encoded = encodeWithCharset(string, charset, encodingName, check, codeRef, args, 1); + return addGenericUtf32Bom(encoded, encodingName, charset).getList(); + } + + /** Perl's generic UTF-32 encoder emits a big-endian BOM; Java's does not. */ + private static RuntimeScalar addGenericUtf32Bom(RuntimeScalar encoded, String name, Charset charset) { + String normalized = name.toLowerCase(Locale.ROOT).replace("-", "").replace("_", ""); + if (!"utf32".equals(normalized) || !"UTF-32".equalsIgnoreCase(charset.name())) { + return encoded; + } + String bytes = encoded.toString(); + if (bytes.startsWith("\0\0\uFEFF")) { + return encoded; + } + encoded.value = "\0\0\uFEFF" + bytes; + encoded.type = BYTE_STRING; + return encoded; } /** @@ -990,6 +1027,8 @@ private static String perlCanonicalName(String javaName) { switch (javaName) { case "US-ASCII": return "ascii"; case "UTF-8": return "utf-8-strict"; + case "GB2312": return "euc-cn"; + case "windows-1255": return "cp1255"; case "ISO-8859-1": return "iso-8859-1"; case "ISO-8859-15": return "iso-8859-15"; case "windows-1252": return "cp1252"; @@ -1039,11 +1078,12 @@ public static RuntimeList encoding_encode(RuntimeArray args, int ctx) { if (check == FB_DEFAULT_VAL) { // Fast path: no error handling byte[] bytes = string.getBytes(charset); - return new RuntimeScalar(bytes).getList(); + return addGenericUtf32Bom(new RuntimeScalar(bytes), charsetName, charset).getList(); } // Slow path with error handling - return encodeWithCharset(string, charset, charsetName, check, codeRef, args, 1).getList(); + RuntimeScalar encoded = encodeWithCharset(string, charset, charsetName, check, codeRef, args, 1); + return addGenericUtf32Bom(encoded, charsetName, charset).getList(); } catch (Exception e) { throw new RuntimeException("Cannot encode string with " + charsetName + ": " + e.getMessage()); } diff --git a/src/test/resources/unit/encode_mime_charset_aliases.t b/src/test/resources/unit/encode_mime_charset_aliases.t new file mode 100644 index 0000000000..f448fbc3d0 --- /dev/null +++ b/src/test/resources/unit/encode_mime_charset_aliases.t @@ -0,0 +1,23 @@ +use strict; +use warnings; + +use Encode (); +use Test::More; + +my $ascii = Encode::find_encoding('ANSI X3.4-1968'); +ok(defined($ascii), 'ANSI X3.4-1968 resolves to an encoding'); +is($ascii ? $ascii->name : undef, 'ascii', 'ANSI X3.4-1968 uses Perl Encode ASCII name'); + +my $hz = Encode::find_encoding('HZ-GB-2312'); +ok(defined($hz), 'HZ-GB-2312 resolves to an encoding'); +is($hz ? $hz->name : undef, 'euc-cn', 'HZ-GB-2312 follows Perl Encode alias mapping'); + +my $iso_8859_8_i = Encode::find_encoding('ISO-8859-8-I'); +ok(defined($iso_8859_8_i), 'ISO-8859-8-I resolves to an encoding'); + +my $utf32 = Encode::find_encoding('UTF-32'); +ok(defined($utf32), 'UTF-32 resolves to an encoding'); +is($utf32 ? unpack('H*', $utf32->encode("\x{12345}")) : undef, '0000feff00012345', + 'UTF-32 encoding includes the Perl byte-order mark'); + +done_testing; From b54d44c5a4a905d18cd6b7bc404d5e74fdb261d6 Mon Sep 17 00:00:00 2001 From: Codex Date: Tue, 27 Oct 2026 11:51:13 +0100 Subject: [PATCH 2/2] fix: implement Perl HZ codec behavior Decode and encode HZ shift sequences separately from EUC-CN, preserving Perl Encode alias caching. Cover HZ round trips and generic UTF-32 output. Issue: #1897 Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- .../perlonjava/runtime/perlmodule/Encode.java | 109 +++++++++++++++++- src/main/perl/lib/Encode.pm | 13 ++- .../unit/encode_mime_charset_aliases.t | 17 +++ 3 files changed, 133 insertions(+), 6 deletions(-) diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java b/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java index 13290a8ac1..9b08e255c6 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Encode.java @@ -596,6 +596,9 @@ public static RuntimeList encode(RuntimeArray args, int ctx) { } String string = args.get(1).toString(); + if (isHzEncodingName(encodingName)) { + return encodeHz(string).getList(); + } int check = parseCheck(args, 2); RuntimeScalar codeRef = getCheckCodeRef(args, 2); @@ -619,10 +622,10 @@ private static RuntimeScalar addGenericUtf32Bom(RuntimeScalar encoded, String na return encoded; } String bytes = encoded.toString(); - if (bytes.startsWith("\0\0\uFEFF")) { + if (bytes.startsWith("\0\0\u00FE\u00FF")) { return encoded; } - encoded.value = "\0\0\uFEFF" + bytes; + encoded.value = "\0\0\u00FE\u00FF" + bytes; encoded.type = BYTE_STRING; return encoded; } @@ -733,6 +736,9 @@ public static RuntimeList decode(RuntimeArray args, int ctx) { } String octets = args.get(1).toString(); + if (isHzEncodingName(encodingName)) { + return new RuntimeScalar(decodeHz(octets)).getList(); + } int check = parseCheck(args, 2); RuntimeScalar codeRef = getCheckCodeRef(args, 2); @@ -987,6 +993,10 @@ public static RuntimeList find_encoding(RuntimeArray args, int ctx) { return perlEncObj.getList(); } + if (isHzEncodingName(encodingName)) { + return createEncodingObject(getCharset("GB2312"), "HZ").getList(); + } + try { Charset charset = getCharset(encodingName); return createEncodingObject(charset).getList(); @@ -1006,9 +1016,16 @@ public static RuntimeList _java_find_encoding(RuntimeArray args, int ctx) { } private static RuntimeScalar createEncodingObject(Charset charset) { + return createEncodingObject(charset, null); + } + + private static RuntimeScalar createEncodingObject(Charset charset, String codec) { RuntimeHash encObj = new RuntimeHash(); encObj.put("Name", new RuntimeScalar(perlCanonicalName(charset.name()))); encObj.put("MimeName", new RuntimeScalar(charset.name())); + if (codec != null) { + encObj.put("PerlOnJavaCodec", new RuntimeScalar(codec)); + } RuntimeScalar ref = encObj.createReference(); String packageName = charset.equals(StandardCharsets.UTF_8) ? "Encode::utf8" @@ -1017,6 +1034,88 @@ private static RuntimeScalar createEncodingObject(Charset charset) { return ref; } + private static boolean isHzEncodingName(String name) { + return "hz".equalsIgnoreCase(name) || "hz-gb-2312".equalsIgnoreCase(name); + } + + private static boolean isHzCodec(RuntimeHash encoding) { + RuntimeScalar codec = encoding.get("PerlOnJavaCodec"); + return codec != null && codec.getDefinedBoolean() && "HZ".equals(codec.toString()); + } + + private static RuntimeScalar encodeHz(String text) { + byte[] gb2312 = text.getBytes(getCharset("GB2312")); + java.io.ByteArrayOutputStream output = new java.io.ByteArrayOutputStream(gb2312.length + 8); + boolean gbMode = false; + for (byte value : gb2312) { + int current = value & 0xff; + if (current < 0x80) { + if (gbMode) { + output.write('~'); + output.write('}'); + gbMode = false; + } + if (current == '~') { + output.write('~'); + output.write('~'); + } else { + output.write(current); + } + } else { + if (!gbMode) { + output.write('~'); + output.write('{'); + gbMode = true; + } + output.write(current & 0x7f); + } + } + if (gbMode) { + output.write('~'); + output.write('}'); + } + return new RuntimeScalar(output.toByteArray()); + } + + private static String decodeHz(String octets) { + java.io.ByteArrayOutputStream gb2312 = new java.io.ByteArrayOutputStream(octets.length()); + boolean gbMode = false; + for (int i = 0; i < octets.length(); i++) { + int current = octets.charAt(i) & 0xff; + if (current == '~' && i + 1 == octets.length()) { + continue; + } + if (current == '~' && i + 1 < octets.length()) { + char next = octets.charAt(i + 1); + if (next == '{') { + gbMode = true; + i++; + continue; + } + if (next == '}') { + gbMode = false; + i++; + continue; + } + if (next == '~') { + gb2312.write('~'); + i++; + continue; + } + if (next == '\n') { + i++; + continue; + } + if (next == '\r' && i + 2 < octets.length() && octets.charAt(i + 2) == '\n') { + i += 2; + continue; + } + } + gb2312.write(gbMode && current >= 0x21 && current <= 0x7e ? current | 0x80 : current); + } + return new String(gb2312.toByteArray(), getCharset("GB2312")); + } + /** * Maps a Java canonical charset name to Perl Encode's canonical * encoding name (as returned by C<< $enc->name >>). For encodings @@ -1068,6 +1167,9 @@ public static RuntimeList encoding_encode(RuntimeArray args, int ctx) { // Extract charset name from the blessed hash RuntimeHash hash = (RuntimeHash) self.value; String charsetName = hash.get("Name").toString(); + if (isHzCodec(hash)) { + return encodeHz(string).getList(); + } int check = parseCheck(args, 2); RuntimeScalar codeRef = getCheckCodeRef(args, 2); @@ -1109,6 +1211,9 @@ public static RuntimeList encoding_decode(RuntimeArray args, int ctx) { // Extract charset name from the blessed hash RuntimeHash hash = (RuntimeHash) self.value; String charsetName = hash.get("Name").toString(); + if (isHzCodec(hash)) { + return new RuntimeScalar(decodeHz(octets)).getList(); + } int check = parseCheck(args, 2); RuntimeScalar codeRef = getCheckCodeRef(args, 2); diff --git a/src/main/perl/lib/Encode.pm b/src/main/perl/lib/Encode.pm index 5cb6173294..933f9fe91f 100644 --- a/src/main/perl/lib/Encode.pm +++ b/src/main/perl/lib/Encode.pm @@ -40,10 +40,15 @@ XSLoader::load('Encode', $VERSION); my $enc = eval { _java_find_encoding($name) }; if (defined $enc) { $_encoding_cache{$key} = $enc; - eval { - $_encoding_cache{lc $enc->name} ||= $enc; - $_encoding_cache{lc $enc->mime_name} ||= $enc; - }; + # The HZ codec's Perl canonical name is euc-cn, but that name + # refers to a distinct stateless encoding. Do not cache the HZ + # object under its canonical name or MIME name. + unless ($key eq 'hz' || $key eq 'hz-gb-2312') { + eval { + $_encoding_cache{lc $enc->name} ||= $enc; + $_encoding_cache{lc $enc->mime_name} ||= $enc; + }; + } } return $enc; }; diff --git a/src/test/resources/unit/encode_mime_charset_aliases.t b/src/test/resources/unit/encode_mime_charset_aliases.t index f448fbc3d0..f71c91dddf 100644 --- a/src/test/resources/unit/encode_mime_charset_aliases.t +++ b/src/test/resources/unit/encode_mime_charset_aliases.t @@ -12,6 +12,15 @@ my $hz = Encode::find_encoding('HZ-GB-2312'); ok(defined($hz), 'HZ-GB-2312 resolves to an encoding'); is($hz ? $hz->name : undef, 'euc-cn', 'HZ-GB-2312 follows Perl Encode alias mapping'); +my $hz_codec = Encode::find_encoding('hz'); +ok(defined($hz_codec), 'the HZ codec resolves separately from EUC-CN'); +my $hz_sample = '~{<:Ky2;S{#,NpJ)l6HK!#~}~'; +my $hz_text = $hz_codec ? $hz_codec->decode($hz_sample) : ''; +is(join(',', unpack('U*', $hz_text)), '24049,25152,19981,27442,65292,21247,26045,26044,20154,12290', + 'the HZ codec decodes shifted GB2312 bytes'); +is($hz_codec ? $hz_codec->encode($hz_text) : undef, '~{<:Ky2;S{#,NpJ)l6HK!#~}', + 'the HZ codec encodes the shifted GB2312 sequence'); + my $iso_8859_8_i = Encode::find_encoding('ISO-8859-8-I'); ok(defined($iso_8859_8_i), 'ISO-8859-8-I resolves to an encoding'); @@ -20,4 +29,12 @@ ok(defined($utf32), 'UTF-32 resolves to an encoding'); is($utf32 ? unpack('H*', $utf32->encode("\x{12345}")) : undef, '0000feff00012345', 'UTF-32 encoding includes the Perl byte-order mark'); +my $utf32be = Encode::find_encoding('UTF-32BE'); +is($utf32be ? unpack('H*', $utf32be->encode("\x{12345}")) : undef, '00012345', + 'UTF-32BE encoding has no byte-order mark'); + +my $utf32le = Encode::find_encoding('UTF-32LE'); +is($utf32le ? unpack('H*', $utf32le->encode("\x{12345}")) : undef, '45230100', + 'UTF-32LE encoding has no byte-order mark'); + done_testing;