# Decode on the way in, encode on the way out -- and choose, on purpose, what
# happens to a byte that is not UTF-8. Perl offers several answers to that last
# question; only one of them stops the program.
use v5.36;
use Encode qw(decode encode FB_CROAK LEAVE_SRC);
use File::Temp qw(tempdir);

binmode STDOUT, ':encoding(UTF-8)';

# Warnings are part of this lesson, so they are printed to stdout, in order,
# without the " at FILE line N" perl appends (which would move on every edit).
sub clean ($msg) { $msg =~ s/ at \S+ line \d+.*//sr }
$SIG{__WARN__} = sub ($msg) { print "    warning: ", clean($msg), "\n" };

sub bytes_of ($s)    { join ' ', map { sprintf '%02x', ord } split //, $s }
sub code_points ($s) { join ' ', map { sprintf 'U+%04X', ord } split //, $s }

# One UTF-8 line, and one line from a Latin-1 file: its é is the single byte e9.
my $dir  = tempdir(CLEANUP => 1);
my $file = "$dir/cities.txt";
open my $out, '>:raw', $file or die $!;
print {$out} "Krak\xC3\xB3w\n", "caf\xE9\n";
close $out;

say "--- 1. no layer: bytes ---";
open my $in, '<', $file or die $!;
while (my $line = <$in>) {
    chomp $line;
    say "  length ", length($line), ": ", bytes_of($line);
}
close $in;

say "--- 2. the :encoding(UTF-8) layer: characters, and a warning ---";
open $in, '<:encoding(UTF-8)', $file or die $!;
while (my $line = <$in>) {
    chomp $line;
    say "  length ", length($line), ": $line";
}
close $in;

say "--- 3. decode(), no check: U+FFFD, and no warning ---";
open $in, '<:raw', $file or die $!;
chomp(my @raw = <$in>);
close $in;
say "  ", code_points(decode('UTF-8', $_)) for @raw;

say "--- 4. decode() with FB_CROAK: an exception to catch ---";
for my $bytes (@raw) {
    my $text = eval { decode('UTF-8', $bytes, FB_CROAK | LEAVE_SRC) };
    say defined $text ? "  decoded: $text" : "  died:    " . clean($@);
}
my $input = "Krak\xC3\xB3w";
my $text  = decode('UTF-8', $input, FB_CROAK);
say "  without LEAVE_SRC, the variable is consumed: decoded '$text', \$input is now '$input'";
eval { decode('UTF-8', "Krak\xC3\xB3w", FB_CROAK) };
say "  and a constant cannot be: ", clean($@);

say "--- 5. the :utf8 layer does not check at all ---";
open $in, '<:utf8', $file or die $!;
chomp(my @lax = <$in>);
close $in;
say "  line 2 is valid perl text: ", (utf8::valid($lax[1]) ? 'yes' : 'no');

say "--- 6. twice is wrong in both directions ---";
my $once  = decode('UTF-8', "Krak\xC3\xB3w");
my $twice = decode('UTF-8', $once);
say "  decoded once:  $once   ", code_points($once);
say "  decoded twice: $twice   ", code_points($twice);
my $double = encode('UTF-8', encode('UTF-8', $once));
say "  encoded twice: ", bytes_of($double), "   read back: ", decode('UTF-8', $double);
my $wide = eval { decode('UTF-8', "\x{141}\x{F3}d\x{17A}") } // "died: " . clean($@);
say "  decode() on text above U+00FF: $wide";