view release on metacpan or  search on metacpan

lib/App/karr/Encoding.pm  view on Meta::CPAN

  return;
}


sub yaml_dump {
  my (@data) = @_;
  return from_octets( YAML::XS::Dump(@data) );
}


sub yaml_load {
  my ($chars) = @_;
  return YAML::XS::Load( to_octets($chars) );
}

# One codec for the process. utf8 => 0 is the whole point: the caller gets a
# character string back and the output layer encodes it once, at the edge.
my $JSON;

sub _json {
  return $JSON //= JSON::MaybeXS->new(
    utf8            => 0,
    canonical       => 1,
    convert_blessed => 1,
  );
}


sub json_encode {
  my ($data) = @_;
  return _json()->encode($data);
}


sub json_decode {
  my ($chars) = @_;
  return _json()->decode($chars);
}


sub repair_mojibake {
  my ($data) = @_;

  my $ref = ref $data;
  return { map { $_ => repair_mojibake( $data->{$_} ) } keys %$data }
    if $ref eq 'HASH';
  return [ map { repair_mojibake($_) } @$data ]
    if $ref eq 'ARRAY';
  return $data if $ref;
  return $data unless defined $data;

  return $data unless $data =~ /[^\x00-\x7F]/;   # ASCII: nothing to repair
  return $data if     $data =~ /[^\x00-\xFF]/;   # real characters: already right

  # LEAVE_SRC on both calls, and it is not cosmetic: with a CHECK argument and
  # without it, Encode consumes the source string in place. Omitting it here
  # emptied $data, so every string that reached the decode and failed it -- all
  # ordinary Latin-1 text -- came back as "" instead of unchanged.
  my $octets = eval { encode( 'ISO-8859-1', $data, FB_CROAK | LEAVE_SRC ) };
  return $data unless defined $octets;
  my $decoded = eval { decode( 'UTF-8', $octets, FB_CROAK | LEAVE_SRC ) };
  return defined $decoded ? $decoded : $data;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::karr::Encoding - The character/octet boundary for karr

=head1 VERSION

version 0.600

=head1 SYNOPSIS

    use App::karr::Encoding qw( decode_argv enable_std_utf8 yaml_dump );

    enable_std_utf8();
    decode_argv();

    print yaml_dump( { title => "Fix \x{fc}nicode \x{2014} \x{e4}rger" } );

=head1 DESCRIPTION

karr holds one rule: B<everything inside the program is a Perl character
string, and bytes exist only at the outer edges>. This module is the only place
that crosses that line, so every edge crosses it the same way.

The edges, and who guards them:

=over 4

=item * B<C<@ARGV>> -- L</decode_argv>, called from F<bin/karr> and
F<bin/karr-foundation>.

=item * B<C<STDOUT>/C<STDERR>> -- L</enable_std_utf8>, likewise called from the
two scripts. An in-process caller that captures output (a test, say) has to put
the same layer on its capture handle, because reopening C<STDOUT> drops the
layer the script installed. The same is true of a caller that loads
L<App::karr::Foundation> directly instead of running F<bin/karr-foundation> --
see L<App::karr::Foundation/DESCRIPTION> for what that means in practice.

=item * B<Git refs> -- L<App::karr::Git/write_ref> and
L<App::karr::Git/read_ref> call L</to_octets> and L</from_octets>. Blobs hold
UTF-8 octets; everything above C<read_ref> sees characters.

=item * B<Files> -- L<Path::Tiny>'s C<slurp_utf8>/C<spew_utf8>, which are
already character-level. Nothing extra is needed, and nothing extra may be
added: an C<Encode::encode> in front of a C<spew_utf8> is a double encode.

=item * B<YAML> -- L</yaml_dump> and L</yaml_load>. C<YAML::XS::Dump> emits
octets and C<YAML::XS::Load> expects them, which is the opposite of the rule
above, so those two functions are never called directly. (C<DumpFile> and
C<LoadFile> B<are> character-level and are used unwrapped.)