Decode JSON without UTF8-flagged strings – CPanel

The safest approach is to fix the data structure after the fact.

# The following apply to each of decode_struct_inplace, encode_struct_inplace, downgrade_struct_inplace and upgrade_struct_inplace:
# - Errors are silently ignored. The scalar is left unchanged.
# - Recognizes references to arrays, hashes and scalars. More esoteric references won't processed, and a warning will be issued.
# - Overloaded objects and magical variables are not supported. They may induce incorrect behaviour.
# - The structure is changed in-place. You can use Storable::dclone to make a copy first if need be.
# - For convenience, returns its argument.

# Decodes all strings in a data structure from UTF-8 to Unicode Code Points.
sub decode_struct_inplace { _convert_struct_inplace($_[0], &utf8::decode) }

# Encodes all strings in a data structure from Unicode Code Points to UTF-8.
sub encode_struct_inplace { _convert_struct_inplace($_[0], &utf8::encode) }

# "Downgrades" the string storage format of all scalars containing strings in
# a data structure to the UTF8=0 format if they aren't already in that format.
sub downgrade_struct_inplace { _convert_struct_inplace($_[0], &utf8::downgrade) }

# "Upgrades" the string storage format of all scalars containing strings in
# a data structure to the UTF8=1 format if they aren't already in that format.
sub upgrade_struct_inplace { _convert_struct_inplace($_[0], &utf8::upgrade) }

sub _convert_struct_inplace {
    # Make $arg an alias to $_[0]. Changes to $arg (like changes to $_[0]) will be reflected in the parent.
    our $arg; local *arg = shift;
    my $converter        =  shift;

    my $caller = (caller(1))[3];
    $caller =~ s/^.*:://;    # /

    my %seen;    # Only decode each variable once.
    my %warned;  # Only emit each warning once.

    # Using "my" would introduce a memory cycle we'd have to work to break to avoid a memory leak.
    local *_visitor = sub {
        # Make $arg an alias to $_[0]. Changes to $arg (like changes to $_[0]) will be reflected in the parent.
        our $arg; local *arg = $_[0];

        # Don't decode the same variable twice.
        # Also detects referential loops.
        return $arg if $seen{refaddr($arg)}++;

        my $reftype = reftype($arg);
        if (!defined($reftype)) {
            if (defined($arg)) {
                my $sv = B::svref_2object($arg);  # Meta object.
                if ($sv->isa('B::PV') && ($sv->FLAGS & B::SVf_POK)) {  # Can it contain a string? And does it?
                    $converter->($arg);
                }
            }
        }
        elsif ($reftype eq 'ARRAY') {
            _visitor($_) for @$arg;
        }
        elsif ($reftype eq 'HASH') {
            # Usually, we can avoid converting the keys.
            my $ascii = 1;
            for (keys(%$arg)) {
                if (/[^x00-x7F]/) {
                    $ascii = 0;
                    last;
                }
            }

            if (!$ascii) {
                %$arg = map {
                        $converter->( my $new_key = $_ );
                        $new_key => $arg->{$_}
                    } keys(%$arg);
            }

            _visitor($_) for values(%$arg);
        }
        elsif ($reftype eq 'SCALAR') {
            _visitor($$arg);
        }
        elsif ($reftype eq 'REF') {
            _visitor($$arg);
        }
        else {
            warn("Reference type $reftype not supported by $callern")
                if !$warned{$reftype}++;
        }

        return $arg;
    };

    return _visitor($arg);
}

This is existing code that can be simplified a little since it handles things not present in data structures created by JSON modules.