File Coverage

blib/lib/JSON/YY.pm

Criterion	Covered	Total	%
statement	73	77	94.8
branch	13	16	81.2
condition	7	16	43.7
subroutine	21	23	91.3
pod	8	8	100.0
total	122	140	87.1

package JSON::YY;

use strict;
use warnings;
use Carp;

our $VERSION = '0.04';

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;

    # activate keywords via XS::Parse::Keyword hint keys
    if ($want_doc) {
        $^H{"JSON::YY/$_"} = 1 for @DOC_KEYWORDS;
    }
    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};
            # also enable keyword for exported functions
            $^H{"JSON::YY/$e"} = 1;
        }
    }
}

# 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__