File Coverage

blib/lib/Test/Smoke/Util/LoadAJSON.pm

Criterion	Covered	Total	%
statement	40	42	95.2
branch	4	6	66.6
condition			n/a
subroutine	11	11	100.0
pod	2	2	100.0
total	57	61	93.4

package Test::Smoke::Util::LoadAJSON;
use warnings;
use strict;

our $VERSION = '0.03';

=head1 NAME

Test::Smoke::Util::LoadAJSON - A JSON:PP/JSON::XS Factory Class

=head1 SYNOPSIS

    use Test::Smoke::Util::LoadAJSON;
    my $json = Test::Smoke::Util::LoadAJSON->new->utf8->pretty->encode(\%data);

=head1 DESCRIPTION

This is purely a fallback factory class that helps keep our code clean.

This is for people with a clean perl 5.14+ install that have L but not
JSON. Also people that installed L on a pre-5.14 system.

Also checks for C<$ENV{PERL_JSON_BACKEND}> to force either of the two.

=cut

use Exporter 'import';
our @EXPORT = qw/encode_json decode_json/;

no warnings 'redefine';
my $json_base_class;
sub import {
    my ($class) = @_;
    $json_base_class = $class->find_base_class;

    die "Could not find a supported JSON implementation.\n"
        if !$json_base_class;

    {
        no warnings 'redefine', 'once';
        *encode_json = \&{$json_base_class."::encode_json"};
        *decode_json = \&{$json_base_class."::decode_json"};
    }
    goto &Exporter::import;
}

=head2 my $class = Test::Smoke::Util::LoadAJSON->find_base_class()

On success returns one of: B, B

Returns undef on failure.

=cut

sub find_base_class {
    my @backends = $ENV{PERL_JSON_BACKEND}
        ? ($ENV{PERL_JSON_BACKEND})
        : qw/JSON::PP JSON::XS/;
    for my $try_class (@backends) {
        eval "use $try_class";
        next if $@;
        return $try_class;
        last;
    }
    return;
}

=head2 my $obj = Test::Smoke::Util::LoadAJSON->new()

If a base class is found, will return an instantiated object.

This will die() if no base class could be found.

=cut

sub new {
    my $class = shift;
    return $json_base_class->new(@_);
}

1;

=head1 COPYRIGHT

(c) 2014, All rights reserved.

  * Abe Timmerman

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

See:

=over 4

=item * L

=item * L

=back

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut