File Coverage

blib/lib/XS/Base.pm

Criterion	Covered	Total	%
statement	9	30	30.0
branch	0	8	0.0
condition	0	2	0.0
subroutine	3	6	50.0
pod	0	3	0.0
total	12	49	24.4

package XS::Base;
use strict;
use warnings;
our @EXPORT_OK = qw(has del def clr dump_json load_json strict_mode);
our %EXPORT_TAGS = (all => \@EXPORT_OK);
our $VERSION = '1.04';

use Exporter 'import';
require XSLoader;
XSLoader::load('XS::Base', $VERSION);

# strict_mode([$on_off]) -> current_value or set+return
sub strict_mode {
    if (@_) {
        my $v = shift;
        $v = $v ? 1 : 0;
        XS::Base::set_strict_mode($v);
    }
    return XS::Base::get_strict_mode();
}

# dump_json: 从 XS 取到 root 的引用，序列化后释放该引用
sub dump_json {
    require JSON::XS;
    my $root = XS::Base::get_root_ref();    # 返回一个 inc'ed hashref scalar
    eval {
        my $json = JSON::XS->new->utf8->canonical->encode($root);
        XS::Base::_dec_sv($root);           # 释放 XS 返回的引用
        return $json;
    } or do {
        my $err = $@ || "unknown error";
        XS::Base::_dec_sv($root);
        die $err;
    };
}

# load_json: decode 后要求 top-level 是 hashref，并调用 replace_root
sub load_json {
    my ($json) = @_;
    require JSON::XS;
    my $perl_struct = JSON::XS->new->utf8->decode($json);
    unless (ref $perl_struct eq 'HASH') {
        die "load_json requires top-level JSON object (hash)";
    }
    # replace_root 会在 XS 内部加写锁并 shallow-copy 到内部 root
    XS::Base::replace_root($perl_struct);
    return 1;
}

1;
__END__