File Coverage

blib/lib/JSON/YY.pm

Criterion	Covered	Total	%
statement	78	82	95.1
branch	13	16	81.2
condition	7	16	43.7
subroutine	22	24	91.6
pod	8	8	100.0
total	128	146	87.6

package JSON::YY;

use strict;
use warnings;
use Carp;

our $VERSION = '0.02';

require XSLoader;
XSLoader::load('JSON::YY', $VERSION);

our @EXPORT_OK = qw(encode_json decode_json decode_json_ro);

my @DOC_KEYWORDS = qw(jdoc jget jgetp jset jdel jhas jclone jencode
                       jstr jnum jbool jnull jarr jobj jtype jlen jkeys jdecode
                       jiter jnext jkey jpatch jmerge jfrom jvals jeq
                       jpp jraw jread jwrite jpaths jfind
                       jis_obj jis_arr jis_str jis_num jis_int jis_real jis_bool jis_null);

# functional API — fast XS path, always utf8
*encode_json    = \&_xs_encode_json;
*decode_json    = \&_xs_decode_json;
*decode_json_ro = \&_xs_decode_json_ro;

my %SETTERS = (
    utf8            => \&_set_utf8,
    pretty          => \&_set_pretty,
    canonical       => \&_set_canonical,
    allow_nonref    => \&_set_allow_nonref,
    allow_unknown   => \&_set_allow_unknown,
    allow_blessed   => \&_set_allow_blessed,
    convert_blessed => \&_set_convert_blessed,
    max_depth       => \&_set_max_depth,
);

sub import {
    my $class = shift;
    my @exports;
    my @flags;
    my $want_doc = 0;
    for my $arg (@_) {
        if ($arg eq ':doc') {
            $want_doc = 1;
        } elsif ($arg =~ /^-(.+)/) {
            push @flags, $1;
        } else {
            push @exports, $arg;
        }
    }
    my $caller = caller;
    if ($want_doc) {
        no strict 'refs';
        for my $kw (@DOC_KEYWORDS) {
            *{"${caller}::${kw}"} = \&{"_xs_${kw}"};
        }
    }
    if (@flags) {
        my $coder = $class->new;
        for my $f (@flags) {
            my $setter = $SETTERS{$f}
                or Carp::croak("unknown flag: -$f");
            $coder->$setter(1);
        }
        no strict 'refs';
        *{"${caller}::encode_json"} = sub { $coder->encode($_[0]) };
        *{"${caller}::decode_json"} = sub { $coder->decode($_[0]) };
    }
    if (@exports) {
        no strict 'refs';
        for my $e (@exports) {
            Carp::croak("'$e' is not exported by JSON::YY")
                unless grep { $_ eq $e } @EXPORT_OK;
            *{"${caller}::$e"} = \&{$e};
        }
    }
}

# chaining setters
sub utf8            { $_[0]->_set_utf8($_[1] // 1);            $_[0] }
sub pretty          { $_[0]->_set_pretty($_[1] // 1);          $_[0] }
sub canonical       { $_[0]->_set_canonical($_[1] // 1);       $_[0] }
sub allow_nonref    { $_[0]->_set_allow_nonref($_[1] // 1);    $_[0] }
sub allow_unknown   { $_[0]->_set_allow_unknown($_[1] // 1);   $_[0] }
sub allow_blessed   { $_[0]->_set_allow_blessed($_[1] // 1);   $_[0] }
sub convert_blessed { $_[0]->_set_convert_blessed($_[1] // 1); $_[0] }
sub max_depth       { $_[0]->_set_max_depth($_[1] // 512);     $_[0] }

# wrap XS new to accept keyword args
{
    my $orig_new = JSON::YY->can('new');
    no warnings 'redefine';
    *new = sub {
        my ($class, %args) = @_;
        my $self = $orig_new->($class);
        for my $k (keys %args) {
            my $setter = $SETTERS{$k}
                or Carp::croak("unknown option: $k");
            $self->$setter($args{$k});
        }
        $self;
    };
}

# Doc overloading: stringify to JSON, boolean always true, eq/ne deep compare
package JSON::YY::Doc;
use overload
    '""'     => sub { JSON::YY::_doc_stringify($_[0]) },
    'bool'   => sub { 1 },
    'eq'     => sub { JSON::YY::_doc_eq($_[0], $_[1]) },
    'ne'     => sub { !JSON::YY::_doc_eq($_[0], $_[1]) },
    fallback => 1;

package JSON::YY;
1;

__END__