CodeQuestor CodeQuestor - 1 year ago 46
Perl Question

DBM::Deep is failing to import hashref having 'true' or 'false' values

I have the

text as given below :


"a" : false

I want to create the
hash for above JSON. My code is looks like as given below :

use strict;
use warnings;

use DBM::Deep;
use JSON;
use Data::Dumper;

# create the dbm::deep object
my $db = DBM::Deep->new(
file => 'test.db',
type => DBM::Deep->TYPE_HASH

my $json_text = do {
open( my $json_fh, $path )
or die("Can't open \$path\": $!\n");
local $/;

my $json = JSON->new;
my $data = $json->decode($json_text);
print Dumper($data);

# create dbm::deep hash
eval { $db->{$path} = $data; };

if ($@) {
print "error : $@\n";

I am getting below output/error on execution of above code:


$VAR1 = {
'a' => bless( do{(my $o = 0)}, 'JSON::XS::Boolean' )
error : DBM::Deep: Storage of references of type 'SCALAR' is not supported. at line 26

It seems like, JSON internally uses JSON::XS which convert the 'true' value in JSON::XS::Boolean object and DBM::Deep is not able to handle this, while it can handle the null value.

While the above code is working fine for below inputs:

"a" : 'true' # if true is in quotes


"a" : null

I tried many thing, but nothing worked. Does anyone has any workaround?

Answer Source

The JSON parser you are using, among others, returns an object that works as a boolean when it encounters true or false in the JSON. This allows the data to be re-encoded into JSON without change, but it can cause this kind of issue.

null doesn't have this problem because Perl has a native value (undef) that can be used to represent it unambiguously.

The following convert these objects into simple values.

 sub convert_json_bools {
    local *_convert_json_bools = sub {
        my $ref_type = ref($_[0])
            or return;

        if ($ref_type eq 'HASH') {
            _convert_json_bools($_) for values(%{ $_[0] });
        elsif ($ref_type eq 'ARRAY') {
            _convert_json_bools($_) for @{ $_[0] };
        elsif ($ref_type =~ /::Boolean\z/) {
            $_[0] = $_[0] ? 1 : 0;
        else {
            warn("Unsupported type $ref_type\n");