File Coverage

blib/lib/JSON/Slurper.pm

Criterion	Covered	Total	%
statement	40	92	43.4
branch	9	48	18.7
condition	8	33	24.2
subroutine	10	16	62.5
pod	3	3	100.0
total	70	192	36.4

package JSON::Slurper;
use strict;
use warnings;
use Carp ();
use Exporter::Shiny qw(slurp_json spurt_json);
use File::Basename ();
use File::Slurper  ();
use Scalar::Util   ();

our $VERSION     = '0.12';
our %EXPORT_TAGS = (
    std      => [qw(slurp_json spurt_json)],
    std_auto => [qw(-auto_ext slurp_json spurt_json)],
    slurp_auto => [qw(-auto_ext slurp_json)],
    spurt_auto => [qw(-auto_ext spurt_json)],
);

my $DEFAULT_ENCODER;
sub _build_default_encoder {
    my $e_class = $ENV{JSON_SLURPER_NO_JSON_XS} ? do { require JSON::PP; 'JSON::PP' }
        : eval { require Cpanel::JSON::XS; Cpanel::JSON::XS->VERSION('4.09'); 1 } ? 'Cpanel::JSON::XS'
        : do { require JSON::PP; 'JSON::PP' };
    my $encoder = $e_class->new
        ->utf8
        ->pretty
        ->canonical
        ->allow_nonref
        ->allow_blessed
        ->convert_blessed
        ->escape_slash;
    $encoder->stringify_infnan if $e_class eq 'Cpanel::JSON::XS';
    return $encoder;
}

sub new {
    my ($class, %args) = @_;

    my $encoder;
    if (exists $args{encoder}) {
        $encoder = _validate_encoder(delete $args{encoder});
    } else {
        $encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder);
    }

    my $auto_ext = delete $args{auto_ext};

    Carp::croak "invalid constructor arguments provided: @{[join ',', keys %args]}" if %args;

    bless [$encoder, $auto_ext], $class;
}

sub _generate_slurp_json {
    my ($class) = @_;
    my $auto_ext          = exists $_[3]->{auto_ext};
    my $imported_encoder  = exists $_[3]->{encoder} ? _validate_encoder($_[3]->{encoder}) : undef;

    return sub ($;@) {
        my ($filename, $encoder) = @_;

        if (defined $encoder) {
            _validate_encoder($encoder);
        } elsif ($imported_encoder) {
            $encoder = $imported_encoder;
        } else {
            $encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder);
        }

        my $wantarray = wantarray;
        unless (defined wantarray) {
            Carp::carp 'slurp_json requested without a used return value. Returning from slurp_json';
            return;
        }

        if ($auto_ext and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
            $filename = "$filename.json";
        }

        my $slurped = $encoder->decode(File::Slurper::read_binary($filename));

        if ($wantarray and my $ref = ref $slurped) {
            return @$slurped if $ref eq 'ARRAY';
            return %$slurped if $ref eq 'HASH';
        }

        return $slurped;
    }
}

sub slurp {
    my ($self, $filename) = @_;

    my $wantarray = wantarray;
    unless (defined wantarray) {
        Carp::carp 'slurp requested without a used return value. Returning from slurp';
        return;
    }

    if ($self->[1] and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
        $filename = "$filename.json";
    }

    my $slurped = $self->[0]->decode(File::Slurper::read_binary($filename));
    if ($wantarray and my $ref = ref $slurped) {
        return @$slurped if $ref eq 'ARRAY';
        return %$slurped if $ref eq 'HASH';
    }

    return $slurped;
}

sub _generate_spurt_json {
    my ($class) = @_;
    my $auto_ext          = exists $_[3]->{auto_ext};
    my $imported_encoder  = exists $_[3]->{encoder} ? _validate_encoder($_[3]->{encoder}) : undef;

    return sub ($$;@) {
        my ($data, $filename, $encoder) = @_;

        if (defined $encoder) {
            _validate_encoder($encoder);
        } elsif ($imported_encoder) {
            $encoder = $imported_encoder;
        } else {
            $encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder);
        }

        if ($auto_ext and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
            $filename = "$filename.json";
        }

        File::Slurper::write_binary($filename, $encoder->encode($data));
    }
}

sub spurt {
    my ($self, $data, $filename) = @_;

    if ($self->[1] and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
        $filename = "$filename.json";
    }

    File::Slurper::write_binary($filename, $self->[0]->encode($data));
}

sub _validate_encoder {
    my ($encoder) = @_;

    Carp::confess 'encoder must be an object that can encode and decode'
      unless Scalar::Util::blessed($encoder) && $encoder->can('encode') && $encoder->can('decode');

    return $encoder;
}

1;
__END__